home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMIBEST2.ADF / Best of AMICUS 2 / DougieBase / dougiebase < prev    next >
Text File  |  1987-07-22  |  69KB  |  1,639 lines
  1. 10 'Format Dougie Base FDB-H 
  2. DEFINT a - z
  3. 15 top$ = " PROGRAM REQUEST !":reqx1 = 1:reqy1 = 1:backcol = 2:msgcol = 1:outcol = 3
  4. yes$ = " YES ":no$ = " NO "
  5. WINDOW 1 ,"DOUGIE BASE"
  6. WINDOW OUTPUT 1
  7. WIDTH  76
  8. COLOR 2,3:PRINT  " WELCOME TO DOUGIE BASE! " :COLOR 1,2 :PRINT :PRINT " Set Preferences to 80 columns !":start = 1
  9. records = 100:fields = 10 'Maximum 100 records 10 fields.
  10. start:
  11. DIM hd$(fields + 2),d$(records,fields),d(records,fields),search$(records,fields),it$(records + 50),tl!(records),tb(fields + 2),lf(fields + 2),row$(6) 'cut fields in 1/2 to save memory
  12. y$="h":m$="                                      "
  13. o$="                                      "
  14. bl$=m$+o$:lx=1:IF cl=1 THEN cl = 0:GOTO 30
  15. GOTO 2000
  16. 'Palette 3 = yellow,2 = black,1 = cyan.Palette 0 is screen background
  17. 30 PALETTE 0,0,0,0:PALETTE 3,1,1,.13 
  18. IF start = 1 THEN start = 0:GOTO 35
  19. CLS
  20. 35 PALETTE 1,.47,.87,1:PALETTE 2,0,0,0:COLOR 1,2:LOCATE 3,2
  21. PRINT  "Use UNIFORM FORMAT -- Press ";:COLOR 2,3:PRINT  " U ";
  22. COLOR 1,2:PRINT  " Key"
  23. LOCATE 4,2:PRINT  "Use VARIABLE FORMAT - Press ";:COLOR 2,3
  24. PRINT  " V ";:COLOR 1,2:PRINT " Key"
  25. IF v = 1 THEN LOCATE 6,2:PRINT  "Last access used VARIABLE FORMAT!"
  26. IF tmf = 1 THEN tmf = 0:PRINT :PRINT :PRINT  "  Last attempt had too many fields - > ";fields;" !"
  27. getakey:
  28.   x$ = INKEY$
  29.   x$ = UCASE$(x$)
  30.   IF x$ <> "V" AND x$ <> "U" THEN getakey
  31.   IF x$ = "U" THEN v = 0 :GOTO 1000
  32.   IF x$ = "V" THEN v = 1
  33. CLS:LOCATE 2,2:PRINT " VARIABLE FORMAT :- "
  34. LOCATE 4,3:PRINT "Enter Fields in Horizontal line below."
  35. LOCATE 5,4:PRINT  "( Maximum # of fields = ";fields;")" 
  36. LOCATE 7,3:PRINT  "Hit ";:COLOR 2,3:PRINT  " RETURN ";:COLOR 1,2 
  37. PRINT " after each field heading.":PRINT 
  38. PRINT  " Space between arrows = field length."
  39. PRINT  " Hit ";:COLOR 2,3:PRINT " * ";:COLOR 1,2:PRINT  " Key to terminate entry!"
  40. PRINT  " Fields will continue to register until the ";:COLOR 2,3:PRINT " * ";:COLOR 1,2:PRINT " Key is pushed or the end of"
  41. PRINT " the line is reached!"
  42. COLOR 3,2:LOCATE 15,1:PRINT "         1         2         3         4         5         6         7     "
  43. COLOR 3,2:PRINT "1234567890123456789012345678901234567890123456789012345678901234567890123456"
  44. PRINT:COLOR 2,1 
  45. FOR x = 0 TO 75:PRINT " ";:NEXT x
  46. LOCATE 18,1
  47.  
  48. header:
  49.   GOSUB getkey
  50. figured:
  51.   y = CSRLIN: x = POS(0)
  52.   IF x$ = CHR$(13) THEN LOCATE 19,x-1:PRINT  "|":LOCATE 18,x:lastfield = x:GOTO 155
  53.   COLOR 1,2
  54.   PRINT x$;:IF x$ = CHR$(8) THEN GOSUB 245:IF d1 = 1 THEN d1 = 0:GOTO header
  55.   IF x =76 AND x$ <> "*" THEN LOCATE 20,2:COLOR 1,2:PRINT  "INPUT FINISHED!":ix = 1
  56.   y1$ = y1$ + x$
  57.   IF POS (x) > 76 THEN 185
  58.   IF y1$ = " TOTAL" AND figures = 0 OR y1$ = " COST" AND figures = 0 OR y1$ = " VALUE" AND figures = 0 THEN GOSUB figures
  59.   IF y1$ = " COST" AND figures = 5 THEN y1$ = " COST     ":LOCATE 18,lastfield:PRINT y1$;:x$ = CHR$(13):GOTO figured
  60.   IF y1$ = " COST" AND figures = 6 THEN y1$ = " COST      ":LOCATE 18,lastfield:PRINT y1$;:x$ = CHR$(13):GOTO figured 
  61.   IF y1$ = " TOTAL" AND figures = 5 THEN y1$ = " TOTAL    ":LOCATE 18,lastfield:PRINT y1$;:x$ = CHR$(13):GOTO figured
  62.   IF y1$ = " TOTAL" AND figures = 6 THEN y1$ = " TOTAL     ":LOCATE 18,lastfield:PRINT y1$;:x$ = CHR$(13):GOTO figured      
  63.   IF y1$ = " VALUE" AND figures = 5 THEN y1$ = " VALUE    ":LOCATE 18,lastfield:PRINT y1$;:x$ = CHR$(13):GOTO figured
  64.   IF y1$ = " VALUE" AND figures = 6 THEN y1$ = " VALUE     ":LOCATE 18,lastfield:PRINT y1$;:x$ = CHR$(13):GOTO figured      
  65.   IF x$ = "*" THEN ye = x:GOTO 185
  66.   IF ix = 1 THEN 155
  67.   GOTO header
  68. 155 f = f+1:hd$(f) = y1$:lf(f) =  LEN(y1$):IF f>fields THEN PRINT:PRINT "TOO MANY FIELDS!":CLEAR:DEFINT a - z: cl = 1:v = 1:tmf = 1:GOTO 15
  69. y1$ = ""
  70. tb(1) = 1
  71. tb((f+1)) = x
  72. IF ix = 1 THEN ix = 0:ye = x:GOTO 185
  73. GOTO header
  74. 185 COLOR 1,2:PRINT :PRINT :PRINT :PRINT "Tabs (start position) headings and field lengths follow:":PRINT  
  75.  
  76. FOR i = 1 TO f
  77. COLOR 1,2 : PRINT ;:
  78. PRINT "FIELD " i " = " tb(i) TAB(20) "TITLE = ";: COLOR 2,3:PRINT  hd$(i) ;:COLOR 1,2 :PRINT ""
  79. NEXT i
  80. PRINT :COLOR 2,3: PRINT hd$(1);
  81. FOR i = 2 TO f:x = tb(i):PRINT  TAB(x) ;hd$(i);:NEXT i:IF ye < 76 THEN GOSUB 235
  82. COLOR 1,2:PRINT RIGHT$(STR$(lf(1)),LEN(STR$(lf(1)))-1);:FOR i = 2 TO f:PRINT TAB(tb(i)) RIGHT$(STR$(lf(i)),LEN(STR$(lf(i)))-1);:NEXT i
  83. redo:
  84. PRINT : GOSUB changes
  85. IF x$ = "Y" THEN GOTO whichfield ELSE final
  86.  
  87. 235 IF ye = 1 THEN ye = 76
  88. FOR i = ye TO 76:PRINT  TAB(i) " " ;:NEXT i :RETURN
  89. 245 LOCATE 18,x-1:COLOR 1,1:PRINT  " ";:COLOR 1,2:LOCATE y,x-1:d1 = 1:y1$ = LEFT$(y1$,(LEN(y1$)-1))
  90. RETURN
  91.      
  92. 1000 REM input routine for uniform headings
  93. format:
  94.   CLS:LOCATE 5,5:COLOR 2,3:PRINT  " FORMAT HEADINGS! ":COLOR 1,2:
  95.   LOCATE 7,2:PRINT  "Enter number of fields at prompt!"
  96.   LOCATE 9,2:PRINT  "Maximum # of fields for horizontal format is ";fields
  97.   LOCATE 11,2:INPUT "Number of fields "; f
  98.   IF f > fields THEN PRINT  "Too many fields - maximum is ";fields:GOTO format
  99.   l = INT(76/f):k = INT (76/f)
  100.  IF f = 1 THEN p = 76 ELSE p = INT (46/(f-1))
  101.  IF f = 1 THEN h = 76 ELSE h = INT (46/(f-1))
  102.   LOCATE 13,5:COLOR 2,3:PRINT  "  HORIZONTAL FORMAT  :";:COLOR 1,2:PRINT  "- choose :"
  103.   LOCATE 15,2:PRINT  "1st Entry up to 30 characters   ---   Press  ";:COLOR 2,3:
  104.   PRINT  " #1 ";:COLOR 1,2:PRINT  " key"
  105.   LOCATE 16,2:PRINT  "1st Entry up to";l;"characters   ---   Press  ";:COLOR 2,3:
  106.   PRINT  " #2 ";:COLOR 1,2:PRINT  " key"
  107.   GOSUB getkey:IF x$<> "1" AND x$ <> "2" THEN GOSUB getkey
  108.   IF x$ = "1" THEN uniform = 1:GOTO 1130
  109.   IF x$ = "2" THEN uniform = 2:GOTO 1230
  110. 1130 CLS: LOCATE 5,1 : PRINT  " Enter heading of field 1 at prompt!"
  111.      LOCATE 7,1: PRINT  " Maximum number of characters is 30 !"
  112.      PRINT :INPUT " Enter Field one: ", hd$(1)
  113.      IF LEN(hd$(1)) > 30 THEN PRINT " Too many characters---> 30 Maximum.":GOTO 1130
  114.      hd$(1)= hd$(1)+LEFT$(bl$,30-LEN(hd$(1)))
  115.     COLOR 2,3:PRINT  hd$(1):PRINT 
  116.     COLOR 1,2
  117.     IF f = 1 THEN display
  118. nexttitle:
  119.      FOR i = 2 TO f
  120. 1180 PRINT  " Enter name of field ";i;"at prompt! <?>"
  121.      h = INT (46/(f-1)):PRINT  " Maximum # of characters is ";h
  122.      INPUT hd$(i):IF LEN(hd$(i)) > h THEN PRINT  "Too many characters  > ";h:GOTO 1180
  123.      hd$(i) = hd$(i) + LEFT$(bl$,h - LEN(hd$(i)))
  124.      row = CSRLIN:IF row => 23 THEN CLS:LOCATE 1,2
  125.      COLOR 2,3: PRINT  hd$(i):PRINT 
  126.      COLOR 1,2
  127.      NEXT i     
  128.      GOTO display
  129. 1230 CLS:LOCATE 5,1:FOR i = 1 TO f
  130. 1232 PRINT  " Enter name of field ";i;"at prompt! <?>"
  131.      PRINT  " Maximum number of characters is ";l
  132.      PRINT :INPUT hd$(i)
  133.      IF LEN(hd$(i)) > l THEN PRINT " Too many characters---> " l " Maximum.":GOTO 1232
  134.      hd$(i) = hd$(i) + LEFT$(bl$,l - LEN(hd$(i)))
  135.      row = CSRLIN:IF row => 23 THEN CLS:LOCATE 1,2
  136.      COLOR 2,3:PRINT  hd$(i):PRINT 
  137.      COLOR 1,2
  138.      NEXT i
  139.      
  140. display:
  141.      WINDOW 2,"FIELD HEADINGS",(319,0)-(617,186)
  142.      CLS:LOCATE 5,1 :y3 = CSRLIN
  143.      FOR i = 1 TO f
  144.      y3 = y3 +1
  145.      LOCATE y3,1
  146.      PRINT i;".  "; hd$(i)
  147.      NEXT i
  148.      PRINT :INPUT "  PRESS <RETURN> TO CONTINUE!",x$
  149.      WINDOW CLOSE 2
  150.      
  151. PRINT  "ARE HEADINGS CORRECT? <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  152. GOSUB getkey
  153. IF x$ = "Y" THEN final ELSE GOTO whichfield
  154.  
  155. final:     
  156.   CLS: LOCATE 2,5
  157.   PRINT  " Title bar now looks like this:-" :PRINT 
  158.   COLOR 2,3:FOR i = 1 TO f:PRINT  hd$(i);:NEXT i:COLOR 1,2:PRINT 
  159.   PRINT :PRINT  " DO YOU WANT TO MAKE ANY CHANGES? <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">":GOSUB getkey
  160.   IF x$ = "N" THEN 1310 ELSE GOTO whichfield
  161.   
  162. 1310 PRINT  :PRINT  " TEST HEADINGS ON PRINTER ? <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  163. GOSUB getkey
  164. IF x$ = "Y" THEN GOSUB printer :GOSUB changes:IF x$ = "Y" THEN CLEAR:DEFINT a - z:cl = 1:GOTO 15
  165. GOSUB math
  166. PRINT :PRINT "  DO YOU WANT TO PROTECT DATAFILE WITH PASSWORD ? <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  167. GOSUB answer:IF x$ = "Y" THEN
  168.   dbsecret = 1:GOSUB protect
  169.   ELSE
  170.    dbsecret = 0:pw$ = ""
  171.   END IF
  172.    
  173. dbfilename:
  174.   PRINT 
  175.   COLOR 2,3:LOCATE ,5:PRINT "FILE DISK IN DRIVE?";:COLOR 1,2:PRINT " - Press <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> to continue !":INPUT "",x$ :CLS
  176.   begin = 1:GOSUB 15200
  177. globhdr:
  178.   PRINT :PRINT :PRINT  "    NOW SAVING HEADINGS FOR ";:COLOR 2,3:PRINT  db$
  179.   COLOR 1,2:PRINT 
  180.   ON ERROR GOTO errortrap
  181.   OPEN "O",#1, "hd"+db$
  182.   FOR i = 1 TO f
  183.   WRITE #1,hd$(i),lf(i)
  184.   NEXT i
  185.   CLOSE #1
  186. 1380 OPEN "O",#1,"pf"+db$
  187.   IF su = 1 THEN 1388 ELSE su = 0:ad = 0:tf = 0:mf = 0:mf$ = "0":ar = 0
  188. 1388 WRITE #1,db$,f,y$,uk,su,ad,tf,mf,mf$,ar,v,figures,dbsecret,pw$
  189.   CLOSE #1
  190.   ON ERROR GOTO 0
  191.   IF globaldisk = 1 THEN RETURN
  192.   GOSUB writeformatfile
  193.   GOTO 1430 :REM input data routine
  194.   
  195. 1400 REM input data
  196.   IF n > 0 AND r > 0 THEN 1430
  197.   GOSUB 15200
  198. 1430 n = n+1:r = r+1
  199.   IF LEN(hd$(1)) = 30 THEN b = h
  200.   IF LEN(hd$(1)) = l THEN b = l
  201.   IF v = 1 THEN b = lf(tf)
  202.   IF n > records THEN n = n-1:r = r-1:inputting = 1:GOSUB full:GOSUB filefull
  203.   IF kx = 1 THEN COLOR 2,3:PRINT :PRINT "  INSERT FILE DISK - Press <RETURN> ":COLOR 1,2:ir = 1:INPUT x$
  204.   IF ir = 1 THEN CLS:LOCATE 2,5:COLOR 2,3:PRINT "  SAVING LAST DATA ENTRIES! ":COLOR 1,2:PRINT " ":GOSUB saveroutine:GOSUB filelink
  205.   IF kx = 1 THEN kx = 0:tx = 1:GOTO 1430
  206.   IF kx = 2 THEN kx = 0:GOTO 2000
  207.   CLS:LOCATE 5,1
  208.   IF carryon = 1 THEN carryon = 0:GOTO 1462
  209.   IF nx = 0 THEN GOSUB repeat ' repeat entry mode?
  210. 1462 CLS:IF v = 1 THEN 1570 ' input for l characters variable format
  211.   IF f = 1 THEN h = 76 ELSE h = INT(46 /(f-1)):l = INT(76/f) ' fix for f = 1 !
  212.   IF nx = 0 THEN PRINT :PRINT :PRINT :PRINT :PRINT  " 1ST ENTRY 30 CHARACTERS ----------------HIT ";:COLOR 2,3:PRINT  " #1 ";:COLOR 1,2:PRINT  " KEY"
  213.   IF nx = 0 THEN PRINT :PRINT  " 1ST ENTRY UP TO";l;" CHARACTERS  --------HIT ";:COLOR 2,3:PRINT  " #2 ";:COLOR 1,2:PRINT  " KEY"
  214.   PRINT :PRINT :COLOR 2,3: IF LEN (d$(1,1)) = 30 THEN b = h:PRINT  " PREVIOUS 1ST ENTRIES ARE 30 CHARACTERS LONG!"     
  215.   IF LEN(d$(1,1)) = l THEN b = l:PRINT  " PREVIOUS 1ST ENTRIES ARE ";l;"CHARACTERS LONG!"
  216.   COLOR 1,2
  217.   IF re = 1 THEN PRINT :PRINT " ENTER DATA MANUALLY IF LENGTH OF 1ST ENTRY DIFFERS FROM PREVIOUS FORMAT!"
  218.   IF nx = 1 AND nc = 1 THEN 1485 'nx=1 if continuing format as is
  219.   IF nx = 1 AND nc = 2 THEN 1570
  220.   GOSUB getkey
  221.   IF x$ <> "1" AND x$ <> "2" THEN GOSUB getkey
  222.   IF x$ = "1" THEN nc = 1:GOTO 1485
  223.   IF x$ = "2" THEN nc = 2:GOTO 1570
  224. 1485 GOSUB cursloc
  225. 1486 IF sk = 1 THEN GOSUB cursloc
  226.   IF CSRLIN > 18 THEN CLS
  227.   PRINT :COLOR 2,3 :PRINT  hd$(1):COLOR 1,2
  228.   PRINT:PRINT  " ENTER DATA BELOW: "
  229.   IF su = 1 AND tf = 1 THEN GOSUB 1950:IF tf = 1 THEN nextentries
  230.   IF sk = 0 GOTO 1493
  231. 1488 IF sk = 1 THEN sk = 0:PRINT  x$;:x1$ = ""
  232. 1490 a$ = "":a$ = INKEY$:IF a$ = "" THEN 1490
  233.      x = POS(0):y = CSRLIN:a = ASC(a$+CHR$(0))
  234.      j = LEN(x$+x1$)
  235.      IF a <> 13  THEN 
  236.       IF a = 8 THEN
  237.        LOCATE y,x-1:COLOR 2,3:PRINT " ";:LOCATE y,x-1:COLOR 1,2
  238.        IF j-2 = 0 THEN x1$ = "":GOTO 1490
  239.        IF j-2 < 1 THEN x1$ = "":x$ = "":GOTO 1490 ELSE x1$ = LEFT$(x1$,j-2):GOTO 1490
  240.       END IF
  241.       IF a <> 8 THEN x1$ = x1$+CHR$(a):j = LEN(x1$):PRINT  a$ ;:GOTO 1490
  242.      END IF
  243.   d$(n,1) = x$ + x1$:GOTO 1505
  244. 1493 IF re = 1 THEN 1495
  245.   IF re = 0 THEN 1503
  246. 1495 bk = 0:GOSUB getkee
  247. 1496 IF x$ = CHR$(95) OR x$ = CHR$(13) THEN GOSUB 1750:cx = 1
  248.   IF cx = 1 THEN d$(n,1) = d$((n-bk),1):PRINT  d$(n,1):GOSUB 1760
  249.   IF ch = 1 THEN ch = 0:GOTO 1505
  250.   IF ch = 2 THEN ch = 0:GOTO 1496
  251.   IF ch = 3 THEN ch = 0:GOTO 1488
  252.   IF su = 1 AND i <> tf OR su = 0 THEN LOCATE y,x:sk = 1:GOTO 1486
  253.  
  254. 1503 PRINT :INPUT " DATA  :";d$(n,1)
  255. 1505 IF LEN(d$(n,1)) > 30 THEN CLS:PRINT :PRINT  " TOO MANY CHARACTERS ----> 30 !":GOTO 1503
  256.   IF LEN(d$(n,1)) = 30 THEN
  257.    it$(r) = d$(n,1) + STR$(r)
  258.    ELSE
  259.     d$(n,1) = d$(n,1) + LEFT$(bl$,30-LEN(d$(n,1)))
  260.     it$(r) = LEFT$(d$(n,1),30) + STR$(r)
  261.   END IF
  262.  
  263. nextentries:
  264.  
  265.   FOR i = 2 TO f
  266.   IF CSRLIN > 18 THEN CLS
  267. 1519 GOSUB cursloc
  268. 1520 IF sk = 1 THEN GOSUB cursloc
  269.   PRINT :COLOR 2,3:PRINT  hd$(i):COLOR 1,2
  270.   PRINT:PRINT " ENTER DATA BELOW: "
  271.   PRINT :PRINT  " MAXIMUM NUMBER OF CHARACTERS = "; h
  272.   IF su = 1 AND i = tf THEN GOSUB 1950:IF i = tf THEN 1550
  273.   IF sk = 0 THEN 1530
  274. 1527 IF sk = 1 THEN sk = 0:PRINT  x$;:x1$ = ""
  275. 1528 a$ = "":a$ = INKEY$:IF a$ = "" THEN 1528
  276.      x = POS(0):y = CSRLIN:a = ASC(a$+CHR$(0))
  277.      j = LEN(x$+x1$)
  278.      IF a <> 13  THEN 
  279.       IF a = 8 THEN
  280.        LOCATE y,x-1:COLOR 2,3:PRINT " ";:LOCATE y,x-1:COLOR 1,2
  281.        IF j-2 = 0 THEN x1$ = "":GOTO 1528
  282.        IF j-2 < 1 THEN x1$ = "":x$ = "":GOTO 1528 ELSE x1$ = LEFT$(x1$,j-2):GOTO 1528
  283.       END IF
  284.       IF a <> 8 THEN x1$ = x1$+CHR$(a):j = LEN(x1$):PRINT  a$ ;:GOTO 1528
  285.      END IF
  286.   d$(n,i) = x$ + x1$:GOTO 1542
  287. 1530 IF re = 1 THEN 1532
  288.   IF re = 0 THEN 1540
  289. 1532 bk = 0:GOSUB getkee
  290. 1533 IF x$ = CHR$(95) OR x$ = CHR$(13) THEN GOSUB 1750:cx = 1
  291.   IF cx = 1 THEN d$(n,i) = d$((n-bk),i):IF su = 1 AND i <> tf OR su = 0 THEN PRINT  d$(n,i):GOSUB 1760
  292.   IF ch = 1 THEN ch = 0:GOTO 1542
  293.   IF ch = 2 THEN ch = 0:GOTO 1533
  294.   IF ch = 3 THEN ch = 0:GOTO 1527
  295.   IF su = 1 AND i <> tf OR su = 0 THEN LOCATE y,x:sk = 1:GOTO 1520
  296. 1540 IF sk = 0 AND re = 0 THEN PRINT :PRINT :INPUT " DATA :  ";d$(n,i)
  297. 1542 IF LEN(d$(n,i)) > h THEN CLS:PRINT :PRINT  " TOO MANY CHARACTERS -----> ";h:GOTO 1519
  298.   d$(n,i) = d$(n,i) + LEFT$(bl$,h-LEN(d$(n,i)))
  299.   IF mf = 6 AND VAL(d$(n,ar)) = 0 THEN PRINT  " DIVISION BY 0 IS ILLEGAL !":sk = 0:re = 0:GOTO 1540
  300. 1550 IF CSRLIN > 18 THEN CLS
  301.   NEXT i
  302.   IF su = 1 THEN GOSUB 1970
  303.   GOTO 1620
  304. 1570  ' input for l characters 
  305.   FOR i = 1 TO f:IF v = 1 THEN l = lf(i)
  306. 1572 GOSUB cursloc 
  307. 1573 IF sk = 1 THEN GOSUB cursloc 
  308.   PRINT :COLOR 2,3:PRINT  hd$(i):COLOR 1,2
  309.   PRINT :PRINT  " ENTER DATA BELOW :"
  310.   IF su = 1 AND i = tf THEN GOSUB 1950:IF i = tf THEN 1610
  311.   IF sk = 0 GOTO 1580
  312. 1577 IF sk = 1 THEN sk = 0:PRINT  x$;:x1$ = ""
  313. 1578 a$ = "":a$ = INKEY$:IF a$ = "" THEN 1578
  314.      x = POS(0):y = CSRLIN:a = ASC(a$+CHR$(0))
  315.      j = LEN(x$+x1$)
  316.      IF a <> 13  THEN 
  317.       IF a = 8 THEN
  318.        LOCATE y,x-1:COLOR 2,3:PRINT " ";:LOCATE y,x-1:COLOR 1,2
  319.        IF j-2 = 0 THEN x1$ = "":GOTO 1578
  320.        IF j-2 < 1 THEN x1$ = "":x$ = "":GOTO 1578  ELSE x1$ = LEFT$(x1$,j-2):GOTO 1578
  321.       END IF
  322.       IF a <> 8 THEN x1$ = x1$+CHR$(a):j = LEN(x1$):PRINT  a$ ;:GOTO 1578
  323.      END IF
  324.   d$(n,i) = x$ + x1$:GOTO 1600
  325. 1580 IF re = 1 THEN 1582
  326.   IF re = 0 THEN 1599
  327. 1582 bk = 0:GOSUB getkee
  328. 1583 IF x$ = CHR$(95) OR x$ = CHR$(13) THEN GOSUB 1750:cx = 1
  329.   IF cx = 1 THEN d$(n,i) = d$((n-bk),i):IF su = 1 AND i <> tf OR su = 0 THEN PRINT  d$(n,i):GOSUB 1760
  330.   IF ch = 1 THEN ch = 0:GOTO 1600
  331.   IF ch = 2 THEN ch = 0:GOTO 1583
  332.   IF ch = 3 THEN ch = 0:GOTO 1577
  333.   IF su = 1 AND i <> tf OR su = 0 THEN LOCATE y,x:sk = 1:GOTO 1573
  334. 1599 IF sk = 0 AND re = 0 THEN PRINT :PRINT :INPUT " DATA :  ";d$(n,i)
  335. 1600 IF LEN(d$(n,i)) > l THEN CLS:PRINT :PRINT  " TOO MANY CHARACTERS -----> ";l:GOTO 1572    
  336.   d$(n,i) = d$(n,i) + LEFT$(bl$,l-LEN(d$(n,i))) 
  337.   IF mf = 6 AND VAL(d$(n,ar)) = 0 THEN PRINT  " DIVISION BY 0 IS ILLEGAL !":sk = 0:re = 0:GOTO 1599
  338. 1610 IF CSRLIN > 18 THEN CLS
  339.   NEXT i
  340.   IF su = 1 THEN GOSUB 1970
  341.   IF LEN(d$(n,1)) > 29 THEN
  342.    it$(r) = LEFT$(d$(n,1),30) + STR$(r)
  343.    ELSE
  344.    it$(r) = d$(n,1) + LEFT$(bl$,30-LEN(d$(n,1))) + STR$(r)
  345.   END IF
  346. 1620 CLS:COLOR 2,3:FOR i = 1 TO f:PRINT  hd$(i);:NEXT i:COLOR 1,2:PRINT
  347.   PRINT :PRINT :FOR i = 1 TO f
  348.   PRINT  d$(n,i);:NEXT i
  349.   PRINT :PRINT :PRINT "   HIT <";:COLOR 2,3:PRINT " SPACE ";:COLOR 1,2:PRINT "> TO CONTINUE ENTRIES !"
  350.   GOSUB changes
  351.   IF x$ = "Y" THEN 
  352.      PRINT :PRINT "  ENTER 0 TO CHANGE ENTIRE RECORD !"
  353.      changeinput = 1:nb = n:nb$ = STR$(nb):GOSUB xfield
  354.      IF changeinput = 2 THEN changeinput = 0:GOTO 1462
  355.   ELSEIF x$ = CHR$(32) THEN 
  356.      carryon = 1:GOTO 1430
  357.   ELSE
  358.      GOTO 1700
  359.   END IF
  360. 1700 changeinput = 0:PRINT :PRINT :PRINT  "   DO YOU WANT TO QUIT ENTRIES ?  <";:COLOR 2,3:PRINT  " Y/N ";:COLOR 1,2:PRINT  ">"
  361.   GOSUB answer
  362.   IF x$ = "Y" OR x$ = CHR$(139) THEN nx = 0 :MENU ON :GOTO 2000
  363.   CLS
  364.   IF v = 1 THEN 1430
  365. PRINT :PRINT :PRINT  " CONTINUE THIS FORMAT ------- Press ";:COLOR 2,3:PRINT  " RETURN ":COLOR 1,2
  366. PRINT :PRINT  " CHANGE OPTIONS ------------- Press ";:COLOR 2,3:PRINT  " SPACE ":COLOR 1,2
  367. 1744 x$ = INKEY$:IF x$ <> CHR$(13) AND x$ <> CHR$(32) THEN 1744
  368.   IF x$ = CHR$(32) THEN nx = 0:GOTO 1430
  369.   nx = 1:GOTO 1430
  370. 1750 bk = bk+1:IF bk > n THEN bk = 1
  371. RETURN
  372. 1760 cx = 0:ch$ = INKEY$:IF ch$ = "" THEN 1760
  373.   IF ch$ = CHR$(13) THEN ch = 1:RETURN
  374.   IF ch$ = CHR$(95) THEN ch = 2:RETURN
  375.   x$ = ch$:ch = 3:sk = 1:RETURN
  376.   
  377. full:
  378.   CLS:LOCATE 5,5:COLOR 2,3:PRINT  " FILE NOW FULL ! ":COLOR 1,2
  379.   PRINT :PRINT  " SAVE RECENTLY ENTERED RECORDS ( UP TO RECORD # ";n;") BEFORE"
  380.   PRINT " CONTINUING AS DATA WILL OTHERWISE BE LOST!"
  381.   PRINT :PRINT  " INPUTTING DATA TO NEXT FILE SAVES LAST DATA ENTRIES AUTOMATICALLY !"
  382.   PRINT :PRINT :PRINT :PRINT :PRINT  "   Press  <";:COLOR 2,3:PRINT  " RETURN ";:COLOR 1,2:PRINT  ">."
  383.   INPUT "",x$:RETURN
  384.                           
  385. printer:
  386.   PRINT :PRINT  "  NOW TESTING HEADINGS ON PRINTER !":headtest = 1:GOSUB printerdata
  387.   headtest = 0:RETURN
  388.   
  389. math:
  390.   PRINT :PRINT 
  391.   PRINT " DO YOU WANT MATHEMATICS FUNCTION ? <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">" 
  392.   GOSUB getkey
  393.   IF x$ = "N" THEN su = 0:mf$ = "0":mf = 0:ar = 0:RETURN
  394.   IF x$ = "Y" THEN su = 1:GOSUB mathroutines
  395.       
  396.   
  397. 1937 t = l:IF LEN(hd$(tf)) = h THEN t = h
  398.   IF v = 1 THEN t = lf(tf)
  399. 1940 PRINT :PRINT  "  DON'T USE #'S > ";t;"CHARACTERS!"
  400.   PRINT :RETURN
  401.  
  402. 1950 PRINT :PRINT:IF CSRLIN > 18 THEN CLS
  403.   COLOR 2,3 :PRINT " THIS ENTRY = CALCULATION - Press <RETURN> ":INPUT "",x$       
  404.   COLOR 1,2
  405.   RETURN
  406.  
  407. 1970 REM perform calculations
  408.   tl!(0) = 0
  409.   IF mf > 2 THEN 2900
  410.   IF mf = 1 AND tx = 1 THEN tx = 0:tl!(n) = VAL(d$(n,ad))+tl!(records):GOTO 1980 'records = max record
  411.   IF mf = 1 AND tx = 0 THEN tl!(n) = VAL(d$(n,ad))+tl!(n-1):GOTO 1980
  412.   IF mf = 2 AND tx = 1 THEN tx = 0:tl!(n) = tl!(records)-VAL(d$(n,ad))
  413.   IF mf = 2 AND tx = 0 THEN tl!(n) = tl!(n-1)-VAL(d$(n,ad))
  414.   tl!(n) = ABS(tl!(n))
  415. 1980 d$(n,tf) = STR$(tl!(n))
  416. 1981 d$(n,tf) = d$(n,tf) + LEFT$(bl$,b+1-LEN(d$(n,tf)))
  417. 1982 d$(n,tf) = MID$(d$(n,tf),2,b)
  418.   RETURN
  419.  
  420. mathroutines:
  421.   CLS:COLOR 2,3 :LOCATE 3,5:PRINT  " MATHEMATICS FUNCTIONS "
  422.   COLOR 1,2:PRINT :PRINT 
  423.   PRINT :PRINT "     CHOOSE WHICH OPERATION :"
  424.   PRINT :PRINT  "     ACCUMULATE ---------------- Press ";:COLOR 2,3:PRINT  " + ";:COLOR 1,2:PRINT " KEY"
  425.   PRINT :PRINT  "     DECUMULATE ---------------- Press ";:COLOR 2,3:PRINT  " - ";:COLOR 1,2:PRINT " KEY"
  426.   PRINT :PRINT  "     ADD 2 COLUMNS ------------- Press ";:COLOR 2,3:PRINT  " A ";:COLOR 1,2:PRINT " KEY"
  427.   PRINT :PRINT  "     SUBTRACTION --------------- Press ";:COLOR 2,3:PRINT  " S ";:COLOR 1,2:PRINT " KEY"
  428.   PRINT :PRINT  "     MULTIPLY ------------------ Press ";:COLOR 2,3:PRINT  " M ";:COLOR 1,2:PRINT " KEY"
  429.   PRINT :PRINT  "     DIVISION ------------------ Press ";:COLOR 2,3:PRINT  " D ";:COLOR 1,2:PRINT " KEY"
  430.   PRINT :PRINT 
  431.   COLOR 2,3:FOR i = 1 TO f:PRINT  hd$(i);:NEXT i:COLOR 1,2:PRINT
  432.  
  433.   GOSUB getkey
  434. sift:  IF x$ <>"+" AND x$ <> "-" AND x$ <> "A" AND x$ <> "S" AND x$ <> "M" AND x$ <> "D" THEN GOSUB getkey :GOTO sift
  435.   IF x$ = "+" THEN mf = 1:mf$ = " ACCUMULATE ":GOTO mf2
  436.   IF x$ = "-" THEN mf = 2:mf$ = " DECUMULATE ":GOTO mf2
  437.   IF x$ = "A" THEN mf = 3:mf$ = " ADDING ":GOTO 2800
  438.   IF x$ = "S" THEN mf = 4:mf$ = " SUBTRACTING":GOTO 2800
  439.   IF x$ = "M" THEN mf = 5:mf$ = " MULTIPLYING":GOTO 2800
  440.   IF x$ = "D" THEN mf = 6:mf$ = " DIVIDING":GOTO 2800
  441. 2800 REM calculations - choose fields
  442. 2810 PRINT :PRINT :PRINT  " ENTER # OF FIRST FIELD FOR  ";mf$;:INPUT ad
  443.   PRINT :IF ad > f THEN PRINT  " ONLY ";f;"FIELDS":GOTO 2810
  444. 2830 PRINT :PRINT  mf$; " WITH WHICH FIELD ";: INPUT ar
  445.   PRINT :IF ar > f THEN PRINT  " ONLY ";f;"FIELDS":GOTO 2830
  446.   PRINT :IF ar = ad THEN PRINT  " THAT FIELD ALREADY CHOSEN !":PRINT :GOTO 2830
  447. 2860 PRINT " WHICH FIELD FOR CALCULATION RESULT ";:INPUT tf
  448.   PRINT :IF tf > f THEN PRINT  " ONLY ";f;"FIELDS":GOTO 2860  
  449.   PRINT :IF tf = ad OR tf = ar THEN PRINT  " THAT FIELD ALREADY CHOSEN !":PRINT :GOTO 2860
  450.   GOSUB changes
  451.   IF x$ = "Y" THEN  mathroutines
  452.   RETURN 'GOTO 1937 ' return to 1319
  453.  
  454. mf2:
  455. 1920 PRINT :PRINT : PRINT mf$;:INPUT " WHICH FIELD ";ad
  456.   PRINT :IF ad > f THEN PRINT  " ONLY ";f;"FIELDS":GOTO 1920
  457. 1930 PRINT :INPUT " WHICH FIELD FOR RESULTS ";tf
  458.   PRINT :IF tf > f THEN PRINT  "  ONLY ";f;"FIELDS":GOTO 1930
  459.   PRINT :IF tf = ad THEN PRINT  " THAT FIELD ALREADY CHOSEN !":PRINT :GOTO 1930
  460.  
  461.   GOSUB changes
  462.   IF x$ = "Y" THEN  mathroutines
  463.   RETURN 'GOTO 1937 ' return to 1319
  464.   
  465. 2900 REM calculations +/*-
  466. IF mf = 3 THEN 2930
  467. IF mf = 4 THEN 2940
  468. IF mf = 5 THEN 2950
  469. IF mf = 6 THEN 2960
  470. 2930 tl!(n) = VAL(d$(n,ad))+VAL(d$(n,ar)):d$(n,tf) = STR$(tl!(n)):GOTO 1981
  471. 2940 tl!(n) = VAL(d$(n,ad))-VAL(d$(n,ar)):d$(n,tf) = STR$(tl!(n)):GOTO 1981
  472. 2950 tl!(n) = VAL(d$(n,ad))*VAL(d$(n,ar)):d$(n,tf) = STR$(tl!(n)):GOTO 1981
  473. 2960 tl!(n) = VAL(d$(n,ad))/VAL(d$(n,ar)):d$(n,tf) = STR$(tl!(n)):GOTO 1981
  474.  
  475. 2000 'Menu routine
  476. menusetup:
  477.   MENU 1,0,1, "PROJECT        "
  478.   MENU 1,1,1, "  NEWform< B > "
  479.   MENU 1,2,1, "  LOAD   < L > "
  480.   MENU 1,3,1, "  SAVE   < S > "
  481.   MENU 1,4,1, "  PRINTER< P > "
  482.   MENU 1,5,1, "  BASIC  < X > "
  483.   MENU 1,6,1, "  QUIT   < Q > "
  484.   MENU 2,0,1, "TOOLS          "
  485.   MENU 2,1,1, "  FORMAT NEWDB  < F > "
  486.   MENU 2,2,1, "  INPUT NEW FILE< A > "
  487.   MENU 2,3,1, "  INPUT EXISTING< I > "
  488.   MENU 2,4,1, "  DELETE        < D > "
  489.   MENU 2,5,1, "  CORRECT       < C > "
  490.   MENU 2,6,1, "  NOTES         < N > "
  491.   MENU 3,0,1, "DISPLAY        "
  492.   MENU 3,1,1, "  VIEW DATA     < V > "
  493.   MENU 3,2,1, "  PARAMETERS    < M > "
  494.   MENU 4,0,1, "MANIPULATE     "
  495.   MENU 4,1,1, "  SEARCH        < R > "
  496.   MENU 4,2,1, "  SORT          < T > "
  497.   keycommands$(1) = "BLSPXQ"
  498.   keycommands$(2) = "FAIDCN"
  499.   keycommands$(3) = "VM"
  500.   keycommands$(4) = "RT"
  501.   CLS:LOCATE 12,50:COLOR 2,3:PRINT  "  DOUGIE BASE ---- MENU  "
  502.   LOCATE 2,2:COLOR 2,3:PRINT  "PRESS RIGHT MOUSE BUTTON TO SELECT MENUS"
  503.   LOCATE 3,2:PRINT  "  OR USE KEYBOARD COMMANDS AS PER BELOW!":COLOR 1,2
  504. menuscreen:
  505.   PRINT :PRINT  "  BEGIN FORMAT PROGRAM AGAIN   Press  ";:COLOR 2,3:PRINT  " B ";:COLOR 1,2:PRINT  " Key "
  506.   PRINT  "  LOAD                         Press  ";:COLOR 2,3:PRINT  " L ";:COLOR 1,2:PRINT  " Key "  
  507.   PRINT  "  SAVE                         Press  ";:COLOR 2,3:PRINT  " S ";:COLOR 1,2:PRINT  " Key "
  508.   PRINT  "  OUTPUT TO PRINTER            Press  ";:COLOR 2,3:PRINT  " P ";:COLOR 1,2:PRINT  " Key "
  509.   PRINT  "  QUIT TO SYSTEM               Press  ";:COLOR 2,3:PRINT  " Q ";:COLOR 1,2:PRINT  " Key "
  510.   PRINT  "  EXIT TO BASIC                Press  ";:COLOR 2,3:PRINT  " X ";:COLOR 1,2:PRINT  " Key "
  511.   PRINT  "  FORMAT NEW DATABASE          Press  ";:COLOR 2,3:PRINT  " F ";:COLOR 1,2:PRINT  " Key "
  512.   PRINT  "  INPUT TO NEW FILE            Press  ";:COLOR 2,3:PRINT  " A ";:COLOR 1,2:PRINT  " Key "
  513.   PRINT  "  INPUT EXISTING FILE          Press  ";:COLOR 2,3:PRINT  " I ";:COLOR 1,2:PRINT  " Key "
  514.   PRINT  "  DELETE                       Press  ";:COLOR 2,3:PRINT  " D ";:COLOR 1,2:PRINT  " Key "
  515.   PRINT  "  CORRECT - CHANGE             Press  ";:COLOR 2,3:PRINT  " C ";:COLOR 1,2:PRINT  " Key "
  516.   PRINT  "  NOTES                        Press  ";:COLOR 2,3:PRINT  " N ";:COLOR 1,2:PRINT  " Key "
  517.   PRINT  "  VIEW DATA ON SCREEN          Press  ";:COLOR 2,3:PRINT  " V ";:COLOR 1,2:PRINT  " Key "
  518.   PRINT  "  SEE FILE PARAMETERS          Press  ";:COLOR 2,3:PRINT  " M ";:COLOR 1,2:PRINT  " Key "
  519.   PRINT  "  SEARCH                       Press  ";:COLOR 2,3:PRINT  " R ";:COLOR 1,2:PRINT  " Key "
  520.   PRINT  "  SORT                         Press  ";:COLOR 2,3:PRINT  " T ";:COLOR 1,2:PRINT  " Key "
  521.   PRINT 
  522.   PRINT  "  TO RETURN TO MENU            Press  ";:COLOR 2,3:PRINT  " HELP ";:COLOR 1,2:PRINT  " Key "
  523. mainloop:
  524.   menuid = MENU(0)
  525.   key$ = INKEY$
  526.   IF menuid = 0 AND key$ = "" THEN mainloop
  527.   itemid = MENU(1)
  528.   IF key$ <> "" THEN
  529.    section = 1:WHILE section < 5
  530.     choice = INSTR(keycommands$(section),UCASE$(key$))
  531.     IF choice = 0 THEN section = section+1 ELSE itemid = choice:menuid = section:section = 5
  532.    WEND
  533.   END IF
  534.   ON menuid GOTO project,tools,viewdata,manipulate
  535. GOTO mainloop
  536.  
  537. project:
  538.   ON itemid GOTO begin,ldata,sdata,printerdata,basic,quit
  539.   GOTO mainloop
  540.   
  541. tools:
  542.   ON itemid GOTO create,ina,inexist,wipe,correct,notes
  543.   GOTO mainloop
  544.   
  545. viewdata:
  546.   ON itemid GOTO view,parameters
  547.   GOTO mainloop
  548.   
  549. manipulate:
  550.   ON itemid GOTO search,sort
  551.   GOTO mainloop
  552.  
  553. begin:
  554.  MENU OFF: CLS:LOCATE 12,5:COLOR 2,3:PRINT "  NOTE YOU WILL LOSE DATA IF YOU RESTART PROGRAM!"
  555.  LOCATE 14,5:PRINT  "  CLICK IN THE REQUESTER BOX ABOVE.":COLOR 1,2
  556.  msg$ = " Restart format?"
  557.  request2$ = "No returns to menu!"
  558.  CALL requester
  559.  IF choice$ = "No" THEN MENU ON:GOTO 2000
  560.  CLEAR :CLS:DEFINT a - z:cl = 1
  561.  GOTO 15
  562.  
  563. quit:
  564.  MENU OFF:CLS:LOCATE 12,5:COLOR 2,3:PRINT "  This returns you to AMIGADOS or CLI."
  565.  LOCATE 14,5:PRINT  "  CLICK IN THE REQUESTER BOX ABOVE.":COLOR 1,2
  566.  msg$ = "Do you want to quit ? "
  567.  request2$ = "No returns to menu!"
  568.  CALL requester
  569.  IF choice$ = "No" THEN MENU ON:GOTO 2000
  570.  SYSTEM
  571.  
  572. basic:
  573.  MENU OFF:CLS:LOCATE 12,5:COLOR 2,3:PRINT "  This returns you to BASIC. YOU WILL LOSE DATA!"
  574.  LOCATE 14,5:PRINT  "  CLICK IN THE REQUESTER BOX ABOVE.":COLOR 1,2
  575.  msg$ = " Exit to BASIC ? "
  576.  request2$ = "No returns to menu!"
  577.  CALL requester
  578.  IF choice$ = "No" THEN MENU ON:GOTO 2000
  579.  MENU RESET:CLS:END
  580. ldata:
  581.   CLS:LOCATE 5,4:PRINT "INSERT FILE DISK INTO DRIVE ";df$;" !    PRESS <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> TO CONTINUE !"
  582.   INPUT "",x$
  583.   ON ERROR GOTO errortrap:IF fileload = 1 THEN fileload = 0:GOTO loadin ELSE GOSUB 15200
  584. loadin:                                                     
  585.   preformat = 0  'clear preformat notes flag with each file load in
  586.   OPEN "I" ,#1,"hd" + db$
  587.   f = 1
  588.   WHILE NOT EOF(1)
  589.   INPUT #1,hd$(f),lf(f)
  590.   f = f+1
  591.   WEND
  592.   CLOSE #1
  593.   OPEN "I" ,#1, "pf" + db$
  594.   INPUT #1,db$,f,y$,uk,su,ad,tf,mf,mf$,ar,v,figures,dbsecret,pw$
  595.   IF y$ <> "h" THEN 3260
  596.   CLOSE #1 
  597.   OPEN "I" ,#1,n$
  598.   OPEN "I" ,#2,"if" + n$
  599.   n = 1:r = 1
  600.   WHILE NOT EOF(1)
  601.   FOR i = 1 TO f
  602.   INPUT #1,d$(n,i)
  603.   NEXT i
  604.   n = n+1
  605.   WEND
  606.   CLOSE #1
  607.   n = n-1
  608.   WHILE NOT EOF(2)
  609.   INPUT #2,it$(r)
  610.   r = r+1
  611.   WEND
  612.   CLOSE #2
  613.   r = r -1
  614.   IF su = 1 THEN GOSUB 3400
  615.   ON ERROR GOTO 0
  616.   PRINT :PRINT :PRINT  "   FILE IS LOADED AND CONTAINS ";n;" RECORDS !"
  617.   
  618. 3260 PRINT :CLOSE 1:CLOSE 2
  619. ON ERROR GOTO 0
  620.   IF y$ <> "h" THEN PRINT  "  THIS FILE IS FORMATTED VERTICALLY !"
  621.   IF dbsecret = 1 THEN
  622.    fromload = 1
  623.    GOSUB unprotect:fromload = 0
  624.      IF protect = 2 THEN 
  625.       protect = 0:CLS:PRINT :PRINT :PRINT "  LOAD A DIFFERENT FILE - Press <";:COLOR 2,3:PRINT " L ";:COLOR 1,2:PRINT ">    OR QUIT - Press <";:COLOR 2,3:PRINT " Q ";:COLOR 1,2:PRINT ">."
  626.       GOSUB getkey:IF x$ <> "L" AND x$ <> "Q" THEN GOSUB getkey
  627.       IF x$ = "L" THEN GOTO ldata
  628.       IF x$ = "Q" THEN GOTO quit
  629.      END IF
  630.   END IF 
  631.   COLOR 1,2:PRINT  "   PRESS <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> TO CONTINUE !"
  632.   INPUT "",x$
  633. 3275 IF inexist = 1 THEN inexist = 0:GOTO 1400 'rtn to input routine after inexist load  
  634.   IF rcl = 1 THEN rcl = 0:RETURN 'returns from gosub in recordlist memoryfile
  635.   IF global = 1 THEN RETURN 'returns from gosub in global search
  636.   MENU ON:GOTO 2000
  637.  
  638. 3400 OPEN "I" ,#3,"tl" + n$
  639.   n = 1
  640.   WHILE NOT EOF(3)
  641.   INPUT #3,tl!(n)
  642.   n = n+1
  643.   WEND
  644.   CLOSE #3
  645.   n = n -1
  646.   RETURN
  647.   
  648. sdata:
  649.   IF n = 0 THEN nodata
  650.   CLS:LOCATE 5,5:PRINT "INSERT FILE DISK INTO DATA DRIVE ! ";df$;" PRESS <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> TO CONTINUE !"
  651.   LOCATE 7,37:PRINT "or PRESS <";:COLOR 2,3:PRINT " HELP ";:COLOR 1,2:PRINT "> KEY FOR MENU !"
  652.   GOSUB getkey:IF x$ <> CHR$(13) AND x$ <> CHR$(139) THEN GOSUB getkey
  653.   IF x$ = CHR$(139) THEN MENU ON:GOTO 2000
  654.   saveroutine:
  655.     PRINT  "    NOW SAVING DATA !"
  656.     ON ERROR GOTO errortrap
  657.     OPEN "O",#1, n$
  658.     FOR i = 1 TO n
  659.     FOR y = 1 TO f
  660.     IF global = 1 THEN WRITE #1,search$(i,y) ELSE WRITE #1,d$(i,y)
  661.     NEXT y
  662.     NEXT i
  663.     CLOSE #1
  664.     OPEN "O" ,#2, "if"+ n$
  665.     FOR i = 1 TO r
  666.     WRITE #2,it$(i)
  667.     NEXT i
  668.     CLOSE #2
  669.     IF su = 1 THEN GOSUB tl
  670.     PRINT :PRINT :PRINT  "       DATA IS SAVED !":FOR d = 1 TO 500:NEXT d
  671.     ON ERROR GOTO 0
  672.     IF ir = 1 THEN ir = 0:RETURN
  673.     IF globaldisk = 1 THEN RETURN
  674.     MENU ON:GOTO 2000
  675.     
  676.     tl:
  677.       OPEN "O" ,#1, "tl"+ n$
  678.       FOR i = 1 TO n
  679.       WRITE #1,tl!(i)
  680.       NEXT i 
  681.       CLOSE #1:RETURN
  682.       
  683. printerdata:
  684.   IF headtest = 1 THEN GOTO printeron
  685.   IF n = 0 THEN nodata
  686.   CLS:LOCATE 5,5:COLOR 2,3:PRINT "  DATA PRINTOUT - ":COLOR 1,2  
  687.   IF poweron = 0 THEN LOCATE 7,5:PRINT "  TURN PRINTER ON ???":LOCATE 9,5:PRINT "  REQUIRED PRINTER SETTINGS --  (SET IN PREFERENCES)":LOCATE 11,5:PRINT"  Left Margin = 2, Right Margin = 80":poweron = 1
  688.   printeron:
  689.   OPEN "prt:" FOR OUTPUT AS #4
  690.   ON ERROR GOTO errortrap
  691.   IF headtest = 0 THEN GOSUB linespace
  692.   PRINT :PRINT "  NOW PRINTING .........."
  693.   IF printer = 1 THEN PRINT# 4," SEARCH STRING = ";s$
  694.   IF printnote = 2 THEN GOTO skipheader
  695.   PRINT# 4,CHR$(27);"[4m" 'underline on
  696.   FOR i = 1 TO f
  697.   PRINT# 4,hd$(i);
  698.   NEXT i
  699.   PRINT# 4,CHR$(27);"[24m" 'underline off  
  700.   IF notes = 0 THEN PRINT# 4,CHR$(27);"E"'carriage return and linefeed
  701.   printnote = 2 'prevents header being printed if note printout repeated
  702.   IF headtest = 1 THEN CLOSE# 4:ON ERROR GOTO 0:printnote = 0:RETURN
  703. skipheader:
  704.   IF printer = 1 THEN RETURN 'return from sub for search module
  705.   IF notes = 1 THEN RETURN 'return from sub for noteprintout
  706.   FOR i = 1 TO n
  707.   FOR y = 1 TO f
  708.   PRINT# 4,d$(i,y);
  709.   NEXT y:IF ds = 1 THEN PRINT# 4,CHR$(27);"E"
  710.   PRINT# 4,""  
  711.   NEXT i
  712.   IF fl=1 THEN PRINT# 4,CHR$(27);"E":PRINT# 4," TOTAL = ";tt$
  713.   CLOSE #4
  714.   ON ERROR GOTO 0:printnote = 0  
  715.   MENU ON:GOTO 2000
  716.  
  717. create:
  718.   CLS:CLEAR:DEFINT a -z:cl = 1:GOTO 15
  719.   
  720. ina:
  721.   CLS:CLEAR:DEFINT a - z:cl = 1:GOTO 15
  722.  
  723. inexist:
  724.   CLS:LOCATE 5,5:COLOR 2,3:PRINT " ADD DATA TO EXISTING FILE - "
  725.   COLOR 1,2:LOCATE 7,5:PRINT "IS FILE ALREADY IN MEMORY?  <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  726.   GOSUB answer
  727.   IF x$ = CHR$(139) THEN MENU ON:GOTO 2000
  728.   IF x$ = "Y" THEN 1400
  729.   LOCATE 10,5:PRINT "AFTER FILENAME PROMPT ENTER NAME OF FILE TO APPEND."
  730.   LOCATE 12,5:PRINT  "THE FILE WILL LOAD AND INPUT ROUTINE WILL COMMENCE !"
  731.   LOCATE 14,5:PRINT  "PRESS <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> TO CONTINUE!"
  732.   INPUT "",x$
  733.   inexist = 1:GOTO ldata
  734.     
  735. wipe:
  736.   IF n = 0 THEN GOTO nodata
  737.   CLS:LOCATE 5,5:COLOR 2,3:PRINT " DELETE RECORD MODULE NOW ACTIVE ":COLOR 1,2
  738.   GOSUB pickrecord
  739.   IF nb > n THEN THEN GOSUB wrongentry:GOSUB pickrecord
  740.   IF nb = 0 THEN MENU ON:GOTO 2000
  741.   PRINT :PRINT :PRINT "  RECORD NUMBER ";:COLOR 2,3:PRINT nb;:COLOR 1,2:PRINT "."
  742.   PRINT :PRINT :COLOR 3,2:FOR i = 1 TO f:PRINT d$(nb,i);:NEXT i
  743.   PRINT :PRINT :COLOR 1,2:PRINT "  DELETE THIS RECORD ? - ARE YOU SURE ! <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  744.   GOSUB answer:IF x$ = "N" OR x$ = CHR$(139) THEN MENU ON:GOTO 2000
  745.   d$(nb,1) = "DELETED"
  746.   PRINT :PRINT :PRINT "  DELETING THIS RECORD !"
  747.   'renumber without deleted record.
  748.   q = 1
  749.   FOR i = 1 TO n
  750.   IF d$(i,1) = "DELETED" THEN 11230
  751.   FOR y = 1 TO f
  752.   d$(q,y) = d$(i,y)
  753.   NEXT y
  754.   q = q+1
  755. 11230 NEXT i
  756.   n = n-1 'subtract # of record deleted for new total
  757.   GOTO 11260
  758.    
  759. correct:
  760.   IF n = 0 THEN GOTO nodata
  761.   IF f = 1 THEN h = 76 ELSE h = INT(46 /(f-1)):l = INT(76/f)
  762.   k = l:p = h
  763.   CLS:LOCATE 5,5:COLOR 2,3:PRINT " CORRECTION/CHANGE RECORD MODULE NOW ACTIVE ":COLOR 1,2
  764.   GOSUB pickrecord
  765.   IF nb > n THEN GOSUB wrongentry:GOTO correct
  766.   IF nb = 0 THEN MENU ON:GOTO 2000
  767.   CLS: LOCATE 7,2:PRINT "The Field Titles are --"
  768.   FOR i = 1 TO f:COLOR 1,2:PRINT  i;TAB(10);:COLOR 2,3:PRINT  hd$(i):COLOR 1,2:NEXT i
  769.   PRINT :PRINT "  RECORD # ";:COLOR 2,3:PRINT  nb;:COLOR 1,2:PRINT " IS :-"
  770.   PRINT :COLOR 3,2:FOR i = 1 TO f:PRINT d$(nb,i);:NEXT i
  771. 10140 PRINT :PRINT :COLOR 1,2:PRINT "  IS THIS CORRECT ? <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">":GOSUB answer
  772.   IF x$ = CHR$(139) OR x$ = "Y" THEN 11260
  773.  xfield:
  774.   PRINT :INPUT "  CHANGE WHICH FIELD ";a
  775.   IF a > f THEN PRINT "  THERE ARE ONLY  ";f;" FIELDS !":GOTO xfield
  776.   IF changeinput = 1 AND a = 0 THEN changeinput = 2:RETURN
  777.   CLS:PRINT :PRINT "  ";:COLOR 2,3:PRINT d$(nb,a):COLOR 1,2
  778. 10190 PRINT :PRINT "  ENTER THE CORRECT DATA : "
  779.   INPUT ac$
  780.   IF LEN(ac$) > LEN(d$(nb,a))THEN PRINT :PRINT "  ENTRY IS GREATER THAN ";LEN(d$(nb,a));" CHARACTERS !":GOTO 10190
  781.   IF a = 1 THEN GOSUB changeindex
  782.   IF LEN(d$(nb,a)) = 30 THEN d$(nb,a) = ac$ + LEFT$(bl$,30-LEN(ac$))
  783.   IF LEN(d$(nb,a)) = k THEN d$(nb,a) = ac$ + LEFT$(bl$,k-LEN(ac$))
  784.   IF LEN(d$(nb,a)) = p THEN d$(nb,a) = ac$ + LEFT$(bl$,p-LEN(ac$))
  785.   IF LEN(d$(nb,a)) = l THEN d$(nb,a) = ac$ + LEFT$(bl$,l-LEN(ac$))
  786.   IF LEN(d$(nb,a)) = lf(a) THEN d$(nb,a) = ac$ + LEFT$(bl$,lf(a)-LEN(ac$))
  787.   PRINT :PRINT "  CORRECTION MADE !!" 
  788.   PRINT :PRINT "  RECORD # ";:COLOR 2,3:PRINT nb$;:COLOR 1,2:PRINT " NOW READS :"
  789.   PRINT :COLOR 3,2:FOR y = 1 TO f
  790.   PRINT d$(nb,y);:NEXT y:GOTO 10140
  791. 11260 IF changeinput = 1 THEN RETURN
  792.   PRINT :PRINT :PRINT "  PRESS ";:COLOR 2,3:PRINT " HELP ";:COLOR 1,2:PRINT " KEY TO RETURN TO MENU !"
  793.   PRINT :PRINT:PRINT "  PRESS ";:COLOR 2,3:PRINT "(S)AVE";:COLOR 1,2:PRINT " TO SAVE ALTERED FILE !"   
  794.   GOSUB getkey
  795.   IF x$ <> "S" AND x$ <> CHR$(139) THEN GOSUB getkey
  796.   IF x$ = CHR$(139) THEN MENU ON:GOTO 2000
  797.   IF x$ = "S" THEN GOTO sdata
  798.  
  799. notes:
  800.  notes = 1:protect = 0:hidepass = 0             
  801.   notesmenu:
  802.     IF n = 0 THEN notes = 0:GOTO nodata
  803.     CLS:LOCATE 5,5:COLOR 2,3:PRINT " NOTES MODULE NOW ACTIVE ":COLOR 1,2
  804. preformatcheck:
  805.  IF preformat = 0 THEN 
  806.   ON ERROR GOTO errortrap
  807.   OPEN "I" ,#1,"pfmnote" + n$
  808.   INPUT #1,preformat
  809.   CLOSE #1
  810.   ON ERROR GOTO 0
  811.  END IF        
  812.     GOSUB memoryfile
  813.     PRINT :PRINT "  CHOOSE FROM RECORD LIST   - Press <";:COLOR 2,3:PRINT " R ";:COLOR 1,2:PRINT "> key."
  814.     PRINT :PRINT "  ENTER RECORD TITLE DIRECT - Press <";:COLOR 2,3:PRINT " D ";:COLOR 1,2:PRINT "> key."
  815.     GOSUB getkey
  816.     IF x$ <> "R" AND x$ <> "D" THEN GOSUB getkey
  817.     IF x$ = "D" THEN GOSUB match:GOTO selection    
  818.     IF x$ = "R" THEN GOSUB pickrecord:IF nonotespic = 1 THEN nonotespic = 0:GOTO notes    
  819.     IF nb > n THEN GOSUB wrongentry:GOSUB pickrecord
  820. index:
  821.     a$ = LEFT$(d$(nb,1),30):GOSUB findrn 'match entry with rec#
  822.    selection:
  823. IF notfound = 1 THEN notfound = 0:GOTO morenotes 
  824.     title$ = " DOUGIE BASE ---- NOTES MENU " 
  825.     CALL banner (2,title$,0,0,331,105,0)
  826.     LOCATE 3,5:PRINT "CHOOSE - ";:COLOR 2,3:PRINT " W  R  C  D  M  +  - ";:COLOR 1,2:PRINT " key."
  827.     LOCATE 5,5:PRINT "WRITE NOTE     -  Press ";:COLOR 2,3:PRINT " W ";:COLOR 1,2:PRINT " key."
  828.     LOCATE 6,5:PRINT "READ  NOTE     -  Press ";:COLOR 2,3:PRINT " R ";:COLOR 1,2:PRINT " key."
  829.     LOCATE 7,5:PRINT "CHANGE NOTE    -  Press ";:COLOR 2,3:PRINT " C ";:COLOR 1,2:PRINT " key."
  830.     LOCATE 8,5:PRINT "DELETE NOTE    -  Press ";:COLOR 2,3:PRINT " D ";:COLOR 1,2:PRINT " key."
  831.     LOCATE 9,5:PRINT "MAIN MENU      -  Press ";:COLOR 2,3:PRINT " M ";:COLOR 1,2:PRINT " key."
  832.     LOCATE 10,5:PRINT"FORWARD SCROLL -  Press ";:COLOR 2,3:PRINT " + ";:COLOR 1,2:PRINT " key."  
  833.     LOCATE 11,5:PRINT"BACKWARD SCROLL-  Press ";:COLOR 2,3:PRINT " - ";:COLOR 1,2:PRINT " key." 
  834.     keycommand$ = "WRCDM+-"
  835.     notesloop: 'pg.217 in amigabasic to add mousemenu
  836.     key$ = INKEY$
  837.     WHILE key$ = "" :GOTO notesloop:WEND
  838.     IF key$ <> "" THEN 
  839.       s = INSTR(keycommand$,UCASE$(key$))
  840.       IF s = 0 THEN notesloop ELSE itemid = s
  841.     END IF
  842.     WINDOW OUTPUT 1:CLS:LOCATE 9,50:PRINT "RECORD # ";:COLOR 2,3:PRINT nb;:COLOR 1,2:PRINT "."
  843.     WINDOW CLOSE 2:WINDOW 1
  844.     ON itemid GOTO writenotes,readnotes,changenotes,deletenotes,tomain,forward,backup
  845.     IF itemid = 6 OR itemid = 7 THEN GOTO selection
  846. morenotes:    
  847.     CLS:WINDOW CLOSE 2:LOCATE 5,5:PRINT "MORE NOTES ?  <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  848.     GOSUB answer
  849.     IF x$ = "Y" THEN notes ELSE printnote = 0:notes = 0:pickrec = 0:hidepass = 0:protect = 0:MENU ON :GOTO 2000
  850.   tomain:
  851.   CLS:LOCATE 5,5:PRINT "RETURN TO MAIN MENU !  ARE YOU SURE ?  <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  852.   GOSUB answer:IF x$ = "Y" OR x$ = CHR$(139) THEN WINDOW CLOSE 2:notes = 0:picrec = 0:printnote = 0:hidepass = 0:protect = 0:MENU ON :GOTO 2000 ELSE GOTO notes
  853.     
  854.   writenotes:
  855.     FOR row = 1 TO 5:row$(row) = "":NEXT row
  856.     CLS:LOCATE 5,5:PRINT "SUBJECT TITLE IS : ";:COLOR 2,3:PRINT  s$
  857.     LOCATE 7,5:COLOR 1,2:PRINT "WRITE NOTES BELOW :  - Maximum of 5 lines."
  858.     row = 1
  859.     newrow:
  860.     IF row > 5 THEN GOTO notefinished
  861.     IF extrachr = 1 THEN row$(row) = x$:LOCATE 10+row,1:PRINT row$(row):extrachr = 0:GOTO getletter
  862.     row$(row) = ""
  863.    getletter: 
  864.     x$ = INKEY$:IF x$ = "" THEN getletter
  865.     IF x$ = CHR$(8) THEN GOSUB backspace :GOTO getletter 'handle delete key
  866.     IF x$ = CHR$(13) THEN notefinished
  867.     row$(row) = row$(row) + x$  
  868.     IF LEN(row$(row)) > 76 THEN row$(row) = LEFT$(row$(row),76):extrachr = 1
  869.     LOCATE 10+row,1:COLOR 3,2:PRINT  row$(row)
  870.     IF UCASE$(row$(1)) = "PROTECT" THEN GOSUB protect
  871.     IF extrachr = 1 THEN row = row + 1:GOTO newrow
  872.     IF x$ = CHR$(32) AND LEN(row$(row)) > 65 THEN row = row + 1:GOTO newrow
  873.     IF protect = 1 THEN protect = 0:row = row + 1:GOTO newrow
  874.     GOTO getletter
  875. notefinished:
  876.     IF extrachr = 1 THEN extrachr = 0
  877.     CLS:LOCATE 5,1:COLOR 1,2:PRINT "   NOTES ARE COMPLETE AND READ AS FOLLOWS: -"    
  878.     LOCATE 7,1
  879.     IF hidepass = 1 AND alternote = 1 AND UCASE$(LEFT$(row$(1),7)) <> "PROTECT" THEN hidepass = 0
  880.     IF hidepass = 1 THEN hidepass = 0:FOR x = 2 TO 5:COLOR 3,2:PRINT row$(x);:NEXT x:COLOR 1,2:GOTO skip2
  881.     FOR x = 1 TO 5:COLOR 3,2:PRINT row$(x):NEXT x:COLOR 1,2
  882. skip2:
  883.     GOSUB changes:IF x$ = "Y" THEN GOTO writenotes
  884.     ON ERROR GOTO errortrap
  885.     IF alternote = 1 THEN skipformat
  886.     IF preformat = 1 THEN skipformat 'notes already preformatted flag
  887. snotes:
  888.  PRINT :PRINT "   DO YOU WISH TO PREFORMAT NOTEFILE FOR ";:COLOR 2,3:PRINT n$;:COLOR 1,2:PRINT " ?  <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  889.  PRINT :PRINT "   WITHOUT PREFORMATTING, NOTES MUST BE ENTERED IN SEQUENTIAL ORDER !"
  890.  PRINT :PRINT "   ANY FUTURE PREFORMAT WILL ERASE ALL PREVIOUS NOTES.THUS PREFORMATTING IS"
  891.  PRINT "   RECOMMENDED.(TIME REQUIRED IS 5 MINUTES. ONCE ONLY!)"
  892.  GOSUB answer:IF x$ = "N" THEN GOTO skipformat
  893.  IF x$ = CHR$(139) THEN morenotes
  894.  formatnotes:
  895.   preformat = 1
  896.   OPEN "dbnotes" + n$ AS #1 LEN = 380
  897.   FIELD #1,76 AS sentence$(1),76 AS sentence$(2),76 AS sentence$(3),76 AS sentence$(4),76 AS sentence$(5)
  898.   maxrecnumb = records 'format for 100? records
  899.   FOR k = 1 TO 5 :LSET sentence$(k) = CHR$(255):NEXT k
  900.   FOR rec = 1 TO maxrecnumb:PUT#1,rec:NEXT rec
  901.   CLOSE# 1
  902.   OPEN "O" ,#2, "pfmnote" + n$ 'preformat flag saved
  903.   WRITE #2 ,preformat
  904.   CLOSE #2
  905.   PRINT :PRINT "  FORMATTING FINISHED ! PRESS <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> to continue !"
  906.   INPUT"",x$
  907.  skipformat:
  908.   IF removenote = 1 THEN removenote = 0: PRINT :PRINT "  NOW DELETING NOTES FOR RECORD # ";:COLOR 2,3:PRINT nb;:COLOR 1,2:PRINT ".":GOTO savingnote
  909.   PRINT :PRINT "  NOW SAVING NOTES FOR RECORD # ";:COLOR 2,3:PRINT nb;:COLOR 1,2:PRINT "."
  910.  savingnote:
  911.   OPEN "dbnotes"+ n$ AS #1 LEN = 380
  912.   FIELD#1,76 AS sentence$(1),76 AS sentence$(2),76 AS sentence$(3),76 AS sentence$(4),76 AS sentence$(5)
  913.   FOR j = 1 TO 5:LSET sentence$(j) = row$(j):NEXT j
  914.   PUT# 1,rn
  915.   CLOSE# 1
  916.   ON ERROR GOTO 0
  917.   IF alternote = 1 THEN alternote = 0
  918.   GOTO morenotes
  919. protect:
  920.  protect = 1
  921.  COLOR 1,2:PRINT :PRINT "   ENTER PASSWORD FOR FUTURE ACCESS CODE ! : ";:COLOR 2,3:GOSUB password
  922.  row$(1) = "PROTECT" + code$
  923.  COLOR 1,2:PRINT :PRINT :PRINT "   THANKYOU !  - PRESS <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> TO CONTINUE."
  924.  INPUT "",x$:IF dbsecret = 1 AND notes = 0 THEN pw$ = row$(1):RETURN 'aprox 1310 end of input routine
  925.  CLS:LOCATE 5,2:PRINT "  PLEASE TYPE NOTES BELOW :":COLOR 3,2:RETURN
  926. unprotect:
  927.   COLOR 1,2:PRINT :PRINT "   ENTER PASSWORD FOR ACCESS ! : ";:COLOR 2,3:GOSUB password 
  928.   code = LEN(code$)+7
  929.   IF dbsecret = 1 AND notes = 0 THEN
  930.    IF LEFT$(pw$,code) <> "PROTECT" + code$ THEN reenter ELSE RETURN
  931.   END IF
  932.   IF notes = 1 AND dbsecret = 1 AND rcl = 1 THEN 
  933.    IF LEFT$(pw$,code) <> "PROTECT" + code$ THEN reenter ELSE RETURN  
  934.   END IF 
  935.  IF LEFT$(row$(1),code) <> "PROTECT" + code$ THEN reenter
  936.   PRINT :PRINT :PRINT :COLOR 3,2:FOR row = 2 TO 5:PRINT row$(row):NEXT row:COLOR 1,2
  937.   RETURN
  938.  reenter:  
  939.   BEEP:COLOR 1,2:PRINT :PRINT "   THIS NOTE IS PROTECTED. TRY AGAIN ?  <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  940.   GOSUB answer:IF x$ = "Y" THEN GOTO unprotect ELSE protect = 2: RETURN
  941. password:
  942.   code$ = "":IF notes = 1 AND fromload <> 1 THEN hidepass = 1 'flag so password isn't printed
  943. startpass:
  944.   x$ = INKEY$
  945.   IF x$ = "" THEN startpass
  946.   code$ = code$ + x$
  947.   IF code$ = CHR$(13) THEN password
  948.   IF x$ = CHR$(13) THEN RETURN
  949.   PRINT "*";:GOTO startpass
  950.     
  951. readnotes:
  952.  ON ERROR GOTO errortrap
  953.  OPEN "dbnotes" + n$ AS #2 LEN = 380
  954.  FIELD#2,76 AS row$(1),76 AS row$(2),76 AS row$(3),76 AS row$(4),76 AS row$(5)
  955.  GET# 2,rn
  956.  PRINT :PRINT "  NOTES ON RECORD :";:COLOR 2,3:PRINT s$;:COLOR 1,2:PRINT "."
  957.  IF LEFT$(row$(1),1) = CHR$(255) THEN PRINT :PRINT :PRINT "  NO NOTES WRITTEN ON THIS RECORD !":CLOSE# 1:nonotes = 1:GOTO continuenotes
  958.  IF UCASE$(LEFT$(row$(1),7)) = "PROTECT" THEN GOSUB unprotect:GOTO continuenotes
  959.  PRINT :PRINT :COLOR 3,2:FOR row = 1 TO 5:PRINT row$(row):NEXT row:COLOR 1,2
  960. continuenotes:
  961.  ON ERROR GOTO 0
  962.  PRINT :PRINT "  PRESS <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> TO CONTINUE !"
  963.  INPUT"",x$
  964.  IF alternote = 1 THEN CLOSE# 2: RETURN
  965. hardcopynote:
  966.  IF nonotes = 1 THEN nonotes = 0:CLOSE#2:GOTO readnext
  967.  IF protect = 2 THEN protect = 0:CLOSE# 2:GOTO readnext 'did not know password
  968.  IF LEFT$(row$(2),7) = "DELETED" THEN CLOSE# 2:GOTO readnext
  969.  PRINT :PRINT "  DO YOU WANT A HARDCOPY OF THIS NOTE ?  <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  970.  GOSUB answer:IF x$ = "N" OR x$ = CHR$(139) THEN CLOSE#2:GOTO readnext
  971.  IF printnote = 2 THEN printnote ELSE printnote = 1
  972. printnote:
  973.  GOSUB printerdata
  974.   PRINT# 4,CHR$(27);"E" 'puts a blank line after last note
  975.   FOR y = 1 TO f
  976.   PRINT# 4,d$(nb,y); 'changed rn to nb to allow for delete
  977.   NEXT y
  978.   PRINT# 4,CHR$(27);"E"  
  979.   FOR row = 1 TO 5
  980.   IF passon = 0 THEN IF UCASE$(LEFT$(row$(1),7)) = "PROTECT" THEN row = 2:passon = 1 'don't print password
  981.   IF ASC(row$(row)) = 32 THEN nextrow 'to prevent blank line printout
  982.   PRINT# 4,row$(row):IF ds = 1 THEN PRINT# 4,CHR$(27);"E"
  983. nextrow:
  984.   NEXT row:passon = 0
  985.   CLOSE #4:ds = 0
  986.   CLOSE #2 'clears random access buffer i.e row$() = 0
  987.   ON ERROR GOTO 0  
  988. readnext:
  989.  hidepass = 0
  990.  PRINT :PRINT "  READ NEXT NOTE ?  <";:COLOR 2,3:PRINT " Y or SPACE/N ";:COLOR 1,2:PRINT ">"
  991.  GOSUB answer:IF x$ = "N" OR x$ = CHR$(139) THEN morenotes
  992.  nb = nb + 1:IF nb = records + 1 THEN nb = 1
  993.  s$ = d$(nb,1):a$ = s$
  994.  GOSUB findrn
  995.  IF notfound = 1 THEN notfound = 0:GOTO morenotes
  996.  GOTO readnotes
  997.  
  998. changenotes:
  999.  alternote = 1:GOSUB readnotes:GOSUB changes:IF x$ = "N" THEN GOTO morenotes
  1000.  GOTO writenotes          
  1001. deletenotes:
  1002.  alternote = 1:GOSUB readnotes
  1003.  PRINT :PRINT :PRINT "  DO YOU WISH TO DELETE THE NOTE ON THIS RECORD ?"
  1004.  PRINT "  DELETION PROCESS SIMPLY ERASES NOTES FROM THIS RECORD # ENTRY."
  1005.  PRINT "  SUBJECT REMAINS IN FILE BUT IF DELETED FROM DOUGIE BASE CATALOGUE"
  1006.  PRINT "  SUBJECT WILL NEVER BE ACCESSED !     <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">  ?"
  1007.  GOSUB answer:IF x$ = "N" THEN GOTO morenotes
  1008.  FOR k = 1 TO 5 :row$(k) = "DELETED":NEXT k 
  1009.  removenote = 1:GOTO skipformat
  1010.  
  1011.   match:
  1012.   'match subject and record # 'returns rn and s$
  1013.   CLS:LOCATE 5,5:PRINT "Begin and end Subject title entry with ";:COLOR 2,3:PRINT " * ";:COLOR 1,2:PRINT " to shorten search string!"
  1014.   LOCATE 6,5:PRINT "You must have 1st letters of title sequentially correct to find record." 
  1015.   LOCATE 7,5:PRINT "You can enter as few or as many letters of subject as you wish."
  1016.   LOCATE 8,5:PRINT "Otherwise enter whole title!"
  1017.   rectitle:
  1018.   PRINT :INPUT "  SUBJECT TITLE : ",a$:ls = LEN(a$)
  1019.   IF ls > 30 THEN PRINT "  TOO MANY CHARACTERS IN TITLE - TRY AGAIN!":GOTO rectitle
  1020.   IF LEFT$(a$,1)= "*" THEN ls = ls-2:wc = 1:GOSUB extract:a$ = ss$
  1021.   FOR i = 1 TO n 
  1022.   IF LEFT$(d$(i,1),ls) = a$ THEN nb = i
  1023.   NEXT i
  1024.   findrn:
  1025.   FOR i = 1 TO r
  1026.   IF wc = 1 THEN itemmatch '3120
  1027.   IF LEFT$(it$(i),30) = a$ + LEFT$(bl$,30-LEN(a$)) THEN found '3150
  1028.   IF wc = 0 THEN tryagain '3130
  1029.   itemmatch:
  1030.   IF LEFT$(it$(i),ls) = ss$ THEN found
  1031.   tryagain:
  1032.   NEXT i
  1033.   CLS:LOCATE 12,5:PRINT "SUBJECT NOT IN INDEX !":FOR d = 1 TO 1000:NEXT d:wc = 0:notfound = 1:RETURN'900
  1034.   found:
  1035.   CLS:LOCATE 12,5:PRINT "SUBJECT FOUND IN INDEX !":wc = 0
  1036.   rn = i
  1037.   s$ = LEFT$(it$(i),30)
  1038.   LOCATE 9,50:PRINT "RECORD # ";:COLOR 2,3:PRINT nb;:COLOR 1,2:PRINT "."
  1039.   LOCATE 15,1:COLOR 3,2:FOR i = 1 TO f:PRINT d$(nb,i);:NEXT i:COLOR 1,2
  1040.   FOR d = 1 TO 1000:NEXT d  
  1041.   RETURN    
  1042.  extract:
  1043.    ss$ = ""
  1044.    FOR x = 2 TO ls + 1
  1045.    ss$ = ss$ + MID$(a$,x,1):NEXT x
  1046.    RETURN
  1047. backspace:
  1048.  y = 10+row:x = LEN(row$(row))
  1049.  LOCATE y,x
  1050.  COLOR 2,3:PRINT " ":COLOR 1,2:LOCATE y,1
  1051.  IF x = 1 THEN 
  1052.    COLOR 3,2 :row$(row) = ""
  1053.    RETURN
  1054.  END IF  
  1055.  row$(row) = LEFT$(row$(row),x-1)
  1056.  COLOR 3,2:PRINT row$(row)
  1057.  RETURN
  1058. forward:
  1059.   roll = 1 'backup/forward scroll flag
  1060.   COLOR 3,1
  1061.   nb = nb + 1:IF nb > n THEN nb = 1
  1062.  rollit:
  1063.   IF roll = 1 THEN roll = 0:j = 15:LOCATE j+1,1
  1064.  selected: 
  1065.   FOR i = 1 TO f:PRINT d$(nb,i);:NEXT i:COLOR 1,2
  1066.   LOCATE 9,50:PRINT "RECORD # ";:COLOR 2,3:PRINT nb;:COLOR 1,2:PRINT "."  
  1067.   GOSUB getkey:IF x$ <> "+" AND x$ <> "-" AND x$ <> CHR$(13) THEN GOSUB getkey
  1068.   IF x$ = CHR$(13) THEN GOTO index
  1069.   IF x$ = "+" THEN GOTO forward ELSE nb = nb - 2
  1070.   IF nb < 1 THEN nb = n
  1071.   GOTO forward
  1072. backup:
  1073.   roll = 1
  1074.   COLOR 3,1
  1075.   nb = nb - 1
  1076.   GOTO rollit
  1077.     
  1078. view:
  1079.   IF n = 0 THEN nodata
  1080.   WINDOW 2,"DOUGIE BASE ---- VIEW DATAFILE",(0,0)-(631,52),18
  1081.   LOCATE 1,5:COLOR 2,3:PRINT  " DOUGIE BASE - ";n$;" "
  1082.   LOCATE 2,5:COLOR 1,2:PRINT  STRING$(42," ")
  1083.   LOCATE 3,5:COLOR 1,2:PRINT  " Press ";:COLOR 2,3:PRINT  " SPACE BAR ";:COLOR 1,2:PRINT  " to stop/start scroll ! "
  1084.   IF notes = 1 THEN LOCATE 3,50:COLOR 2,3:PRINT " NOTES MODULE ACTIVE ! ":COLOR 1,2    
  1085.   LOCATE 4,5:PRINT  " Press ";:COLOR 2,3:PRINT  "  ANY  ";:COLOR 1,2:PRINT  " key to exit                ":IF notes = 1 THEN LOCATE 4,50:PRINT "SPACE-RETURN TO SELECT."
  1086.   LOCATE 5,5:PRINT  STRING$(42," ")
  1087.   COLOR 2,3:FOR i = 1 TO f:PRINT  hd$(i);:NEXT i  
  1088.   WINDOW OUTPUT 1
  1089.   COLOR 1,2:PRINT  " "
  1090.   CLS
  1091.   LOCATE 8,1
  1092.   screenprint:
  1093.   FOR i = 1 TO n
  1094.   fieldpos = 1
  1095.   FOR y = 1 TO f:fieldpos = fieldpos + LEN(hd$(y))
  1096.   IF LEFT$(hd$(y),5) = " COST" OR LEFT$(hd$(y),6) = " TOTAL" OR LEFT$(hd$(y),6) = " VALUE" THEN
  1097.      value! = VAL(d$(i,y))
  1098.      IF y = 1 THEN LOCATE ,1
  1099.      IF y > 1 THEN LOCATE ,fieldpos - LEN(hd$(y))    
  1100.      IF figures = 5 THEN PRINT USING "$$####.##";value!;:GOTO nextfield
  1101.      IF figures = 6 THEN PRINT USING "$$#####.##";value!;:GOTO nextfield
  1102.   END IF
  1103.   IF y = 1 GOTO why1
  1104.   LOCATE ,fieldpos - LEN(hd$(y)) 
  1105. why1:
  1106.   PRINT  d$(i,y);
  1107. nextfield:
  1108.   NEXT y
  1109.   x$ = INKEY$:IF x$ = CHR$(32) THEN GOSUB waitforspace:IF pickrec = 1 THEN i = n
  1110.   IF x$ <> "" THEN i = n
  1111.   NEXT i
  1112.   IF pickrec = 1 THEN WINDOW CLOSE 2:RETURN 'to pickrecord
  1113.   IF su = 1 THEN GOSUB printtotal
  1114.   IF sort = 1 THEN RETURN
  1115.   PRINT:PRINT:PRINT  "   Press <";:COLOR 2,3:PRINT  " SPACE BAR ";:COLOR 1,2:PRINT  "> to continue !"
  1116.   GOSUB waitforspace:IF notes = 1 THEN WINDOW CLOSE 2:nonotespic = 1:RETURN
  1117.   IF n < records THEN WINDOW CLOSE 2:MENU ON :GOTO 2000
  1118.   WINDOW CLOSE 2:GOSUB filefull
  1119.   IF kx = 1 THEN kx = 0:GOSUB filelink:GOSUB fileload:GOTO ldata
  1120.   WINDOW CLOSE 2:MENU ON:GOTO 2000
  1121.   
  1122. parameters:
  1123.   IF n = 0 THEN GOTO nodata
  1124.   WINDOW 2,"DOUGIE BASE ---- PARAMETERS OF DATAFILE",(0,0)-(631,185),0
  1125.   COLOR 1,2: CLS
  1126.   LOCATE 1,9:COLOR 2,3:PRINT  " DOUGIE BASE - ";n$;" ":COLOR 1,2
  1127.   LOCATE 3,3:PRINT "DATA FILE HEADINGS ARE AS FOLLOWS :":LOCATE 5,1
  1128.   COLOR 2,3:FOR i = 1 TO f:PRINT  hd$(i);:NEXT i:COLOR 1,2
  1129.   LOCATE 7,1:PRINT "  NUMBER OF FIELDS IN FILE = ";:COLOR 2,3:PRINT f:COLOR 1,2
  1130.   PRINT:PRINT "  FORMAT IS HORIZONTAL.   CURRENT NUMBER OF RECORDS = ";:COLOR 2,3:PRINT n;:COLOR 1,2:PRINT "."
  1131.   PRINT:PRINT "  REMAINING MEMORY IS : ";:COLOR 2,3:PRINT FRE(0);:COLOR 1,2:PRINT " bytes free!"
  1132.   PRINT:PRINT "  ROOM FOR ";:COLOR 2,3:PRINT records-n;:COLOR 1,2:PRINT " MORE RECORDS IN FILE ";:COLOR 2,3:PRINT lx$:COLOR 1,2
  1133.   PRINT:IF su = 0 THEN PRINT "  PRESS <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> TO RETURN TO MENU !":INPUT "",x$:WINDOW CLOSE 2:WINDOW OUTPUT 1:MENU ON:GOTO mainloop
  1134.   IF su = 1 THEN PRINT "  MATHEMATIC FUNCTION IS - ";:COLOR 2,3:PRINT mf$:COLOR 1,2:IF figures = 5 OR figures = 6 THEN LOCATE 15,45:PRINT "  $ FORMATTED TO ";:COLOR 2,3:PRINT figures;:COLOR 1,2:PRINT " FIGURES."
  1135.   IF ar = 0 THEN ar = tf
  1136.   PRINT:PRINT "  FIRST OPERAND IS FIELD # ";:COLOR 2,3:PRINT ad:COLOR 1,2:PRINT "  ";:COLOR 2,3 
  1137.   PRINT mf$;:COLOR 1,2:PRINT " WITH FIELD # ";:COLOR 2,3:PRINT ar:COLOR 1,2
  1138.   PRINT:PRINT "  CALCULATION RESULTS ARE IN FIELD # ";:COLOR 2,3:PRINT tf:COLOR 1,2
  1139.   PRINT :PRINT "   **   PRESS <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> TO RETURN TO MENU !   **"
  1140.   INPUT "",x$:WINDOW CLOSE 2:WINDOW OUTPUT 1:MENU ON:GOTO mainloop
  1141.  
  1142. search:
  1143.  g = 1:globfilno = 1 'initialize record in global search
  1144.   nodata:
  1145.     IF n = 0 THEN CLS:LOCATE 4,5:PRINT  "   NO DATA IN MEMORY - HIT ANY KEY TO EXIT !":WINDOW OUTPUT 1:CLOSE #1:GOSUB getkee:GOTO 2000
  1146.     IF f = 1 THEN h = 76 ELSE h = INT(46 /(f-1)):l = INT(76/f)
  1147.     CLS:LOCATE 5,5:COLOR 2,3:PRINT " SEARCH MODULE NOW ACTIVE ":COLOR 1,2
  1148. fields:
  1149.     LOCATE 7,2:PRINT "The Field Titles are --"
  1150.     LOCATE 9,1:FOR i = 1 TO f:COLOR 1,2:PRINT  i;TAB(10);:COLOR 2,3:PRINT  hd$(i):COLOR 1,2:NEXT i
  1151. 8060 IF sort = 1 THEN PRINT :INPUT "  Sort in which field? ",e$:GOTO 8065
  1152.      PRINT :INPUT "  Search in which field? ",e$
  1153. 8065 PRINT :IF e$< "1" OR e$ > "9" THEN PRINT  "  CHOOSE A # NOT A LETTER !!":GOTO 8060
  1154.      c = VAL(e$)
  1155.      IF c > f THEN LOCATE 10,48:PRINT "ONLY ";f;" FIELDS":LOCATE 14,2:GOTO 8060
  1156.      PRINT :PRINT  "  FIELD  : ":PRINT :COLOR 2,3:PRINT  hd$(c):COLOR 1,2
  1157.      IF sort = 1 THEN RETURN
  1158.      PRINT :PRINT "  ENTER CHARACTERS FOR WHICH YOU WISH TO SEARCH AT PROMPT !"
  1159.      PRINT :PRINT "  ";:COLOR 2,3:PRINT " * ";:COLOR 1,2:PRINT " = Wildcard . -- ";:COLOR 2,3:PRINT " ] ";:COLOR 1,2:PRINT " = End of string ."
  1160. 8100 PRINT :INPUT ">",s$:ls$ = s$:ls = LEN(ls$):ec = ls-1
  1161.      PRINT "  Do you want a GLOBAL search ? -- <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT  ">"
  1162.      GOSUB answer:IF x$ = "Y" THEN global = 1 ELSE global = 0
  1163. 8150 PRINT "  Do you want simultaneous HardCopy ? -- <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT  ">"
  1164.      GOSUB answer:IF x$ = "Y" THEN printer = 1:CLS:GOSUB printerdata ELSE printer = 0
  1165.   IF globalscreen = 1 THEN CLS:GOTO 8155      
  1166.   WINDOW 2,"DOUGIE BASE ---- SEARCH DATAFILE",(0,0)-(631,52),18
  1167. 8155 LOCATE 1,5:COLOR 2,3:PRINT  " DOUGIE BASE - ";n$;:COLOR 1,2:PRINT " Searching for - ";:COLOR 2,3:PRINT ls$
  1168. commonwindow:
  1169.   LOCATE 2,5:COLOR 1,2:PRINT  STRING$(42," ")
  1170.   LOCATE 3,5:COLOR 1,2:PRINT  " Press ";:COLOR 2,3:PRINT  " SPACE BAR ";:COLOR 1,2:PRINT  " to stop/start scroll ! "
  1171.   LOCATE 4,5:PRINT  " Press ";:COLOR 2,3:PRINT  "  ANY  ";:COLOR 1,2:PRINT  " key to exit !              "
  1172.   LOCATE 5,5:PRINT  STRING$(42," ")
  1173.   COLOR 2,3:FOR i = 1 TO f:PRINT  hd$(i);:NEXT i
  1174.   WINDOW OUTPUT 1
  1175.   COLOR 1,2:PRINT  " "
  1176.   CLS
  1177.   LOCATE 8,1
  1178.   IF sort = 1 THEN RETURN     
  1179.   IF globalscreen = 1 THEN RETURN  
  1180. 8160 k = l:p = h:i = 1
  1181.      IF v = 0 AND LEN(d$(i,c))=20 THEN GOSUB 8610
  1182.      IF v = 0 AND LEN(d$(i,c))=p THEN GOSUB 8620
  1183.      IF v = 1 AND LEN(d$(i,c))=lf(c) THEN GOSUB 8625
  1184.      IF v = 0 AND LEN(d$(i,c))=k THEN GOSUB 8630
  1185.      FOR i = 1 TO n:sb = LEN(d$(i,c)):bs = sb
  1186.      IF MID$(ls$,1,1) = "*" THEN wc = 1:GOSUB 8800:IF wp = 1 THEN wp = 0:wc =0:CLOSE #1:WINDOW CLOSE 2:ON ERROR GOTO 0:GOTO search
  1187.      IF wc = 1 THEN wc = 0:GOSUB 8830:IF sm = 1 THEN sm = 0:GOSUB 8500
  1188.      IF MID$(ls$,1,1) = "]"THEN GOSUB 8855:IF em = 1 THEN em = 0:wc = 0:GOSUB 8500
  1189.      IF d$(i,c) = s$ OR LEFT$(d$(i,c),ls) = ls$ THEN GOSUB 8500
  1190.      x$ = INKEY$:IF x$ = CHR$(32) THEN GOSUB waitforspace
  1191.      IF x$ <> "" THEN i = n
  1192.      NEXT i
  1193.      IF global = 1 AND i > records THEN 
  1194.       GOSUB filefull
  1195.        IF kx = 2 THEN kx = 0:GOTO 8400
  1196.        IF kx = 1 THEN kx = 0:WINDOW CLOSE 2:GOSUB filelink:GOSUB fileload:GOSUB ldata:glblsr = 1:GOTO 8160
  1197.      END IF  
  1198.      IF global = 1 AND glblsr = 1 THEN 
  1199.        PRINT :PRINT  "  PUT GLOBAL SEARCH ON SCREEN ?  <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  1200.        CLOSE #4
  1201.        GOSUB answer:IF x$ = "Y" THEN 
  1202.          WINDOW CLOSE 2:CLS
  1203.          GOSUB globalscreen 
  1204.          ELSE 
  1205.           WINDOW CLOSE 2
  1206.           GOTO globalsave
  1207.          END IF
  1208. globalsave:
  1209.        PRINT :PRINT "  SAVE GLOBAL SEARCH TO DISK ? <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  1210.        GOSUB answer:IF x$ = "Y" THEN globsav = 1:CLS:PRINT :GOSUB globaldisk
  1211.      END IF                       
  1212.      IF gx = 1 THEN gx = 0:RETURN 'return to g > records routine
  1213. 8400 printer = 0:glblsr = 0:global = 0:globalscreen = 0:CLOSE #1:CLOSE #4:WINDOW CLOSE 2:ON ERROR GOTO 0
  1214.      PRINT :PRINT  "  ANY MORE SEARCHES ? <";:COLOR 2,3:PRINT  " Y/N ";:COLOR 1,2:PRINT  ">"
  1215.      GOSUB answer:IF x$ = "Y" THEN GOTO search
  1216.      MENU ON:GOTO 2000
  1217. 8500 'search on screen and/or hardcopy
  1218.      FOR y = 1 TO f
  1219.      PRINT  d$(i,y);
  1220.      IF global = 1 THEN search$(g,y) = d$(i,y)     
  1221.      IF printer = 1 THEN PRINT# 4, d$(i,y);
  1222.      NEXT y
  1223.      IF printer = 1 THEN PRINT# 4,""
  1224.      IF global = 1 THEN g = g + 1
  1225.        IF g > records THEN
  1226.        gx = 1:g = records:PRINT "  GLOBAL SEARCH BUFFER FULL !!!":GOSUB globalsave
  1227.         IF globsav = 1 THEN globfilno = globfilno + 1:globsav = 0
  1228.        END IF
  1229.      PRINT  :RETURN
  1230. 8610 s$ = s$ + LEFT$(bl$,30-LEN(s$)):RETURN
  1231. 8620 s$ = s$ + LEFT$(bl$,p-LEN(s$)):RETURN
  1232. 8625 s$ = s$ + LEFT$(bl$,lf(i)-LEN(s$)):RETURN
  1233. 8630 s$ = s$ + LEFT$(bl$,k-LEN(s$)):RETURN     
  1234. 8800 IF RIGHT$(ls$,1)<>"*" THEN PRINT  "  END SEARCH STRING WITH ";:COLOR 2,3:PRINT  " * ";:COLOR 1,2:PRINT " !":wp = 1:FOR d = 1 TO 5000:NEXT d:RETURN
  1235. 8805 ss$ = "":ns = ls-2
  1236. 8810 FOR x = 2 TO ns + 1
  1237. 8815 ss$ = ss$ + MID$(ls$,x,1)
  1238. 8820 NEXT x:RETURN
  1239. 8830 FOR x = 1 TO sb
  1240. 8835 sm$ = MID$(d$(i,c),x,ns)
  1241. 8840 IF sm$ = ss$ THEN sm = 1:RETURN
  1242. 8845 NEXT x
  1243. 8850 RETURN
  1244. 8855 IF MID$(d$(i,c),sb,1) = " " THEN sb = sb-1:GOTO 8855
  1245. 8856 es$ = LEFT$(d$(i,c),sb)
  1246. 8857 IF RIGHT$(es$,ec) = MID$(ls$,2,ec) THEN em = 1:sb = bs:RETURN
  1247. 8860 RETURN
  1248.  
  1249. sort:
  1250.   IF n = 0 THEN GOTO nodata
  1251.   CLS:LOCATE 2,5:COLOR 2,3:PRINT " SORT MODULE NOW ACTIVE ":COLOR 1,2
  1252.   sort = 1:GOSUB fields
  1253.   PRINT :PRINT "  SORT IN ASCENDING ";:COLOR 2,3:PRINT " A ";:COLOR 1,2:PRINT " or DESCENDING ";:COLOR 2,3:PRINT " D ";:COLOR 1,2:PRINT " ORDER ?"
  1254.   GOSUB getkey:IF x$ <> "A" AND x$ <> "D" THEN GOSUB getkey
  1255.   IF x$ = "A" THEN order = 1:order$ = " ASCENDING ORDER ! "
  1256.   IF x$ = "D" THEN order = 0:order$ = " DESCENDING ORDER ! "
  1257.   title$ = " DOUGIE BASE ---- SORT DATAFILE " 
  1258.   CALL banner (2,title$,0,0,631,52,18)
  1259.   LOCATE 1,37:COLOR 1,2:PRINT " Sorting field # ";:COLOR 2,3:PRINT c;:COLOR 1,2:PRINT  order$
  1260.   GOSUB commonwindow 'use search window
  1261.   PRINT "   NOW SORTING  -  PLEASE WAIT !"
  1262.   fr = 0:rf = 0:i = 1
  1263. 6030 x = i + 1
  1264.   IF ASC(MID$(d$(i,c),1,1)) => 48 AND ASC(MID$(d$(i,c),1,1)) = < 57 THEN 6600
  1265. 6040 IF (order = 0) THEN IF d$(i,c) > d$(x,c) THEN 6060
  1266.   IF (order = 1) THEN IF d$(i,c) < d$(x,c) THEN 6060
  1267. 6050 d$(0,0) = d$(i,c):d$(i,c) = d$(x,c):d$(x,c) = d$(0,0)
  1268.   GOSUB 6200
  1269. 6060 x = x + 1
  1270.   IF vn = 1 THEN IF x <= n THEN 6600
  1271.   IF x <= n THEN 6040
  1272.   i = i + 1:fr = fr + 1
  1273.   LOCATE 10,1:PRINT "   SORT IN PROGRESS -- ";i;" ITEMS SORTED !"
  1274.   IF i <> n THEN 6030
  1275.   vn = 0:GOSUB screenprint
  1276.   sort = 0:CLOSE# 1:WINDOW CLOSE 2:ON ERROR GOTO 0:MENU ON:GOTO 2000
  1277. 6200 IF c = 1 THEN 6240
  1278.   IF c = f THEN 6340
  1279.   FOR fx = 1 TO c-1
  1280.   d$(0,0) = d$(i,fx):d$(i,fx) = d$(x,fx):d$(x,fx) = d$(0,0)
  1281.   NEXT fx
  1282. 6240 FOR fx = c+1 TO f
  1283.   d$(0,0) = d$(i,fx):d$(i,fx) = d$(x,fx):d$(x,fx) = d$(0,0)
  1284.   NEXT fx:RETURN
  1285. 6340 FOR fx = 1 TO c-1
  1286.   d$(0,0) = d$(i,fx):d$(i,fx) = d$(x,fx):d$(x,fx) = d$(0,0)
  1287.   NEXT fx:RETURN
  1288. 6600 REM sort for value of numbers
  1289.   vn = 1
  1290.   t$ = d$(i,c)
  1291.   tx$ = d$(x,c)
  1292.   d(i,c) = VAL(d$(i,c))
  1293.   d(x,c) = VAL(d$(x,c))
  1294.   IF (order = 0) THEN IF d(i,c) > d(x,c) THEN d$(i,c) = t$:d$(x,c) = tx$:GOTO 6060
  1295.   IF (order = 1) THEN IF d(i,c) < d(x,c) THEN d$(i,c) = t$:d$(x,c) = tx$:GOTO 6060         
  1296.   GOTO 6050
  1297. RequesterSub: 'Adapted from Amazing Computing.Vol 1 #7 Steve Michel
  1298. SUB requester STATIC:
  1299. SHARED top$,msg$,reqx1,reqy1,backcol,msgcol,outcol,choice$,request2$,yes$,no$
  1300. IF request2$ = "" THEN yes$ = " OK ":no$ = " CANCEL " 
  1301.  reqx2 = reqx1 + 206: reqy2 = reqy1 + 47
  1302.   yesx = 23: yesy = 26:nox = 134: noy = yesy
  1303.   WINDOW 2,top$,(reqx1,reqy1)-(reqx2,reqy2),0
  1304.   WINDOW OUTPUT 2:PAINT (100,20),backcol
  1305.   msgpad$ = " " + LEFT$(msg$,22) + " "
  1306.   msglen = LEN(msgpad$)
  1307.   xloc = INT ((24-msglen)/2) + 1:xline = (xloc-1)*8
  1308.   COLOR msgcol: LOCATE 2,xloc: PRINT  msgpad$;
  1309.   LINE (xline,7)-(xline+8*msglen-1,7),0
  1310.   LINE (yesx,yesy)-(yesx+57,yesy+18),outcol,bf
  1311.   COLOR msgcol: LOCATE 5,5:PRINT  yes$;
  1312.   LINE (32,31)-(71,31),0
  1313.   LINE (nox,noy)-(nox+50,noy+18),outcol,bf
  1314.   LINE (144,31)-(175,31),0
  1315.   LOCATE 5,19: PRINT  no$;
  1316.   
  1317. waiter:
  1318.   choice$ = "none"
  1319.   WHILE MOUSE(0) <> 1
  1320.   WEND
  1321.   xpos = MOUSE(1): ypos = MOUSE(2)
  1322.   IF ypos < yesy OR ypos > yesy+18 THEN waiter
  1323.   IF xpos >= yesx AND xpos <= yesx+54 THEN choice$ = "YES"
  1324.   IF xpos >= nox AND xpos <=nox + 48 THEN choice$ = "No"
  1325.   IF choice$ = "none" THEN waiter
  1326.   yes$ = " YES ":no$ = " NO "
  1327.   WINDOW CLOSE 2
  1328. END SUB
  1329.  
  1330. getkey:
  1331.   x$=INKEY$
  1332.   IF x$ = "" THEN getkey
  1333.   x$ = UCASE$(x$)
  1334.   RETURN
  1335.  
  1336. getkee:
  1337.   x$=INKEY$
  1338.   IF x$ = "" THEN getkee
  1339.   RETURN
  1340.  
  1341. choosenum:
  1342.   x$ = INKEY$
  1343.   x$ = UCASE$(x$)
  1344.   IF x$ <> "1" AND x$ <> "2" THEN choosenum
  1345.   RETURN
  1346.     
  1347. changes:  
  1348.   PRINT :PRINT :PRINT "   DO YOU WANT TO MAKE ANY CHANGES ?  <";:COLOR 2,3:PRINT " Y/N ";:COLOR 1,2:PRINT ">"
  1349.   GOSUB answer
  1350.   IF x$ = "Y" THEN change = 1
  1351.   RETURN
  1352.        
  1353. cursloc:
  1354.   y = CSRLIN 'get current cursor line # (vertical position)
  1355.   x = POS(0) 'get current cursor column number (horizontal position)
  1356.   RETURN
  1357.  
  1358. answer:
  1359.   x$ = INKEY$
  1360.   IF x$ = "" THEN answer
  1361.   x$ = UCASE$(x$)
  1362.   IF x$ <> "Y" AND x$ <> "N" AND x$ <> CHR$(139) AND x$ <> CHR$(32) THEN answer
  1363.   RETURN
  1364.                
  1365. repeat:
  1366.   PRINT :PRINT :PRINT  " DO YOU WISH REPEAT ENTRY MODE  ? <";:COLOR 2,3:PRINT  " Y/N ";:COLOR 1,2:PRINT  ">"
  1367.   GOSUB answer :IF x$ = CHR$(139) THEN GOSUB answer
  1368.   IF x$ = "Y" THEN re = 1 ELSE re = 0:CLS :RETURN
  1369.   PRINT :PRINT" ";:COLOR 2,3:PRINT  " REPEAT ENTRY MODE ON !":COLOR 1,2
  1370.   PRINT :PRINT :PRINT  " IF ENTRY SAME AS ANY PREVIOUS IN THAT FIELD PRESS ";:COLOR 2,3
  1371.   PRINT  " SHIFT - ";:COLOR 1,2:PRINT  " KEYS "
  1372.   PRINT  " TO FIND DATA."
  1373.   PRINT :PRINT  " Press <";:COLOR 2,3:PRINT  " RETURN ";:COLOR 1,2:PRINT  "> TO SET ENTRY !"
  1374.   PRINT :PRINT  " ANY KEY CANCELS REPEAT !"
  1375.   PRINT :PRINT  " CONTINUE  --- Press <";:COLOR 2,3:PRINT  " RETURN ";:COLOR 1,2 :PRINT  ">."
  1376.   INPUT "", x$:CLS : RETURN
  1377.     
  1378. printtotal:
  1379.   k = INT(76/f):p = INT(46/(f-1))
  1380.   offset = INSTR(hd$(tf),"TOTAL")
  1381.   IF UCASE$(MID$(hd$(tf),offset,5)) <> "TOTAL" THEN RETURN
  1382.   IF mf <3 THEN RETURN
  1383.   IF LEN (hd$(tf)) = k THEN tk$ = " TOTAL" + LEFT$(bl$,(k-6))
  1384.   IF LEN (hd$(tf)) = p THEN tp$ = " TOTAL" + LEFT$(bl$,(p-6))
  1385.   IF LEN (hd$(tf)) = lf(tf) THEN tf$ = " TOTAL" + LEFT$(bl$,(lf(tf)-6))
  1386.   IF hd$(tf) = tk$ OR hd$(tf) = tp$ OR hd$(tf) = tf$ THEN fl = 1:GOTO sumloop  
  1387.   RETURN
  1388.   sumloop:
  1389.     FOR i = 1 TO n
  1390.     tt! = tt! + VAL(d$(i,tf))
  1391.     NEXT i
  1392.     tt$ = STR$(tt!)
  1393.     IF fl = 1 THEN PRINT " ":PRINT  "   TOTAL  =  ";tt$;" (for file # ";:COLOR 2,3:PRINT lx$;:COLOR 1,2:PRINT ")."
  1394.     tt! = 0
  1395.     RETURN
  1396.     
  1397. waitforspace:
  1398.   x$ = INKEY$
  1399.   IF x$ <> CHR$(32)  THEN 
  1400.     IF x$ = CHR$(13) THEN 
  1401.      IF notes = 1 THEN pickrec = 1:nb = i
  1402.     ELSE
  1403.      GOTO waitforspace
  1404.     END IF
  1405.   END IF
  1406.   x$ = ""
  1407.   RETURN
  1408.                                                            
  1409. filefull:
  1410.   PRINT :PRINT  "  THIS FILE ( ";:COLOR 2,3:PRINT  n$ ;:COLOR 1,2:PRINT " ) IS NOW FULL !"
  1411.   PRINT :PRINT  "  LINK NEXT FILE IN THIS DATABASE ? <";:COLOR 2,3:PRINT  " Y/N ";:COLOR 1,2:PRINT  ">"
  1412.   GOSUB answer
  1413.   IF x$ = "Y" THEN kx = 1:RETURN
  1414.   IF x$ = "N" THEN kx = 2:RETURN
  1415. filelink:
  1416.   CLS:PRINT :PRINT  "  NAME OF DATABASE IN MEMORY IS ";:COLOR 2,3:PRINT  db$ ;:COLOR 1,2:PRINT " !"
  1417.   lx = VAL(LEFT$(n$,1))
  1418.   lx = lx + 1:l$ = STR$(lx):lx$ = MID$(l$,2)
  1419.   COLOR 1,2:PRINT  " ":PRINT  "  NEXT FILE IS # ";:COLOR 2,3:PRINT  lx$;:COLOR 1,2:PRINT  " .":PRINT 
  1420.   n$ = lx$ + db$:n = 0:r = 0
  1421.   IF inputting = 1 THEN inputting = 0:GOSUB writeformatfile
  1422.   PRINT  "  PRESS <";:COLOR 2,3:PRINT  " RETURN ";:COLOR 1,2:PRINT  "> TO CONTINUE !"
  1423.   INPUT "",x$:RETURN 
  1424. fileload:
  1425.  fileload = 1:PRINT  "     LOAD THIS FILE       - PRESS <";:COLOR 2,3:PRINT  " RETURN ";:COLOR 1,2:PRINT ">":PRINT 
  1426.   PRINT  "  or ENTER DESIRED FILE # - PRESS <";:COLOR 2,3:PRINT  " # ";:COLOR 1,2:PRINT  "> key .":COLOR 1,2
  1427.   GOSUB getkee
  1428.   IF x$ <> "#" AND x$ <> CHR$(13) THEN GOSUB getkee
  1429.   IF x$ = "#" THEN GOSUB filenumber
  1430.   RETURN
  1431.  
  1432. 15200 'input filename for loading
  1433.   PRINT :PRINT "   ENTER DRIVE NUMBER CONTAINING DATA DISK ! (1 or 0)":PRINT
  1434.   PRINT "   PRESS <";:COLOR 2,3:PRINT" RETURN ";:COLOR 1,2:PRINT "> TO DEFAULT TO DRIVE 1 (EXTERNAL DRIVE)"
  1435. device:
  1436.   df$ = INKEY$:IF df$ <> "0" AND df$ <> "1" AND df$ <> CHR$(13) THEN device
  1437.   IF df$ = CHR$(13) THEN df$ = "df1:"
  1438.   IF df$ = "0" THEN df$ = "df0:" ELSE df$ = "df1:"
  1439.   PRINT :PRINT "   PRESS <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> FOR ROOT DIRECTORY."
  1440.   PRINT :INPUT "   DIRECTORY NAME : ",dirname$
  1441.   dir$ = df$+dirname$
  1442.   CHDIR dir$ 'change to current directory on drive 1
  1443.   IF globaldisk = 1 THEN RETURN
  1444.   PRINT :PRINT :PRINT "   ENTER NAME OF DATABASE : ";:INPUT db$
  1445.   IF begin = 1 THEN begin = 0:lx$ = "1":GOTO 15210 'from format heading
  1446. filenumber:
  1447.   PRINT :PRINT "   ENTER THE FILE NUMBER : ";:INPUT lx$
  1448. 15210 n$ = lx$ +db$:RETURN
  1449.  
  1450. errortrap:
  1451.   BEEP 'get users attention
  1452.   IF ERR=53 THEN
  1453.     msg$=" FILE NOT FOUND ! "
  1454.     GOTO exiterror
  1455.   END IF
  1456.   IF ERR= 61 THEN
  1457.     msg$=" DISK FULL ! "
  1458.     GOTO exiterror
  1459.   END IF
  1460.   IF ERR=64 THEN
  1461.     msg$=" BAD FILENAME. "
  1462.     GOTO exiterror
  1463.   END IF
  1464.   IF ERR=67 THEN
  1465.     msg$=" DIRECTORY FULL ! "
  1466.     GOTO exiterror
  1467.   END IF
  1468.   IF ERR=68 THEN
  1469.     msg$=" DEVICE UNAVAILABLE ! "
  1470.     GOTO exiterror
  1471.   END IF
  1472.   IF ERR=70 THEN
  1473.     msg$=" DISK WRITE-PROTECTED ! "
  1474.     GOTO exiterror
  1475.   END IF
  1476.   IF ERR=74 THEN
  1477.     msg$=" UNKNOWN DISK VOLUME ! "
  1478.     GOTO exiterror
  1479.   END IF
  1480.   msg$= "ERROR NUMBER "+STR$(ERR)
  1481. exiterror:
  1482.   'Abort operation or try again.
  1483.   'Define global variable scrid (Screen id ) if required :
  1484.   scrid = -1 ' Error requester will appear on Workbench screen.
  1485.   request2$=""
  1486.   CALL requester 
  1487.   IF choice$ = "No" THEN
  1488.     CLOSE #1:CLOSE #2:CLOSE #3 'change to proper file#
  1489.     IF notes = 1 THEN notes = 0 :CLOSE #4
  1490.     RESUME 2000
  1491.   ELSE
  1492.     CLOSE #1:CLOSE #2:CLOSE #3
  1493.     ON ERROR GOTO errortrap
  1494.     IF ERR = 68 THEN RESUME printeron
  1495.     IF ERR = 53 THEN RESUME ldata ELSE RESUME 'resumes at line that caused error - retry
  1496.   END IF
  1497.   
  1498. linespace:
  1499.   PRINT :PRINT :LOCATE ,5:COLOR 2,3:PRINT "  CHOOSE LINE SPACING - ":COLOR 1,2
  1500.   PRINT :PRINT "  SINGLE SPACING     -  Press ";:COLOR 2,3:PRINT " 1 ";:COLOR 1,2:PRINT " key"
  1501.   PRINT :PRINT "  DOUBLE SPACING     -  Press ";:COLOR 2,3:PRINT " 2 ";:COLOR 1,2:PRINT " key"
  1502.   GOSUB choosenum
  1503.   IF x$ = "1" THEN ds = 0
  1504.   IF x$ = "2" THEN ds = 1
  1505.   RETURN
  1506.     
  1507. pickrecord: 'returns chosen record# in nb
  1508.   PRINT :PRINT :PRINT "  PICK RECORD # OR TITLE FROM LIST OF RECORDS :"
  1509.   IF notes = 1 THEN PRINT :PRINT "  PRESS SPACE BAR AT RECORD'S FIRST APPEARANCE IN SCROLL TO SELECT.":GOTO 14000
  1510.   PRINT :PRINT "  ENTER THIS  AFTER  PROMPT."
  1511. 14000 PRINT :PRINT :PRINT "  PRESS <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> FOR LIST OF RECORDS !"
  1512.   INPUT "",x$
  1513.   IF notes = 1 THEN GOSUB view ELSE GOSUB recordlist 
  1514.   IF pickrec = 1 THEN pickrec = 0:RETURN         
  1515.   IF nonotespic = 1 THEN RETURN 'didn't pick so try all over
  1516.   PRINT :COLOR 2,2:PRINT CHR$(15):COLOR 1,2:INPUT "  WHICH RECORD # ";nb$ 'chr$(15) negates shifted keyboard bug.
  1517.   nb = VAL(nb$):CLS:pickrec = 0:RETURN
  1518.     
  1519. wrongentry:
  1520.   CLS:LOCATE 5,5:PRINT  "This is an incorrect entry!"
  1521.   LOCATE 7,5:PRINT "Press <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT "> TO continue!"
  1522.   INPUT "",x$:RETURN
  1523.  
  1524. recordlist:
  1525.   CLS:LOCATE 5,5:COLOR 2,3:PRINT " RECORD NUMBERS ":COLOR 1,2
  1526.  memoryfile:
  1527.   LOCATE 8,3:PRINT "SEE FILE NOW IN MEMORY   -- Press <";:COLOR 2,3:PRINT " RETURN ";:COLOR 1,2:PRINT ">"
  1528.   LOCATE 10,3:PRINT "LOAD DIFFERENT FILE      -- Press <";:COLOR 2,3:PRINT " L ";:COLOR 1,2:PRINT "> key."
  1529.   GOSUB getkey:IF x$ <> "L" AND x$ <> CHR$(13) THEN GOSUB getkey
  1530.   IF x$ = CHR$(13) THEN 12577
  1531.   IF x$ = "L" THEN rcl = 1:GOSUB ldata
  1532.   IF notes = 1 THEN RETURN
  1533.   IF nf = 1 THEN nf = 0:MENU ON:GOTO 2000
  1534. 12577 IF n = 0 THEN GOTO nodata
  1535.   IF notes = 1 THEN RETURN
  1536.   WINDOW 2,"DOUGIE BASE ---- RECORD LIST",(0,0)-(631,52),18
  1537.   LOCATE 1,5:COLOR 2,3:PRINT  " DOUGIE BASE - ";n$;:COLOR 1,2:PRINT " PICK RECORD # - "
  1538.   LOCATE 2,5:COLOR 1,2:PRINT  STRING$(42," ")
  1539.   LOCATE 3,5:COLOR 1,2:PRINT  " Press ";:COLOR 2,3:PRINT  " SPACE BAR ";:COLOR 1,2:PRINT  " to stop/start scroll ! "
  1540.   LOCATE 3,50:PRINT " ENTER '0' FOR MENU ! "
  1541.   LOCATE 4,5:PRINT  " Press ";:COLOR 2,3:PRINT  "  ANY  ";:COLOR 1,2:PRINT  " key to exit !              "
  1542.   LOCATE 5,5:PRINT  STRING$(42," ")
  1543.   COLOR 2,3:PRINT "  RECORD # ";TAB(14);" RECORD TITLE ";:COLOR 1,2
  1544.   WINDOW OUTPUT 1
  1545.   COLOR 1,2:PRINT  " "
  1546.   CLS
  1547.   LOCATE 8,1
  1548.   FOR i = 1 TO n
  1549.   PRINT  TAB(5);i;TAB(15);d$(i,1)
  1550.   x$ = INKEY$:IF x$ = CHR$(32) THEN GOSUB waitforspace:IF pickrec = 1 THEN i = n
  1551.   IF x$ <> "" THEN i = n 'didn't hit space
  1552.   NEXT i
  1553.   IF picrec = 1 THEN RETURN
  1554.   PRINT:PRINT:PRINT  "   Press <";:COLOR 2,3:PRINT  " SPACE BAR";:COLOR 1,2:PRINT  "> to continue !"
  1555.   GOSUB waitforspace: WINDOW CLOSE 2:RETURN
  1556.   
  1557. changeindex:
  1558.   'change index file if 1st field changed.
  1559.   FOR i = 1 TO r                                                         
  1560.   IF LEFT$(it$(i),30) = LEFT$(d$(nb,1),30) THEN GOSUB 14100
  1561.   IF LEFT$(it$(i),p) = d$(nb,1) THEN GOSUB 14100
  1562.   IF LEFT$(it$(i),k) = d$(nb,1) THEN GOSUB 14100
  1563.   IF LEFT$(it$(i),lf(a)) = d$(nb,1) THEN GOSUB 14100
  1564.   NEXT i
  1565.   RETURN
  1566. 14100 it$(i) = ac$+LEFT$(bl$,30-LEN(ac$))+STR$(i):GOTO 14110
  1567. 14110 PRINT :COLOR 3,2:PRINT LEFT$(it$(i),30);:COLOR 1,2:PRINT " = INDEX RECORD # ";:COLOR 2,3:PRINT i;:COLOR 1,2:PRINT "."
  1568. RETURN
  1569.   
  1570. SUB banner (bannerid%,title$,x1%,y1%,x2%,y2%,type%) STATIC
  1571.   SHARED n$
  1572.   WINDOW bannerid%,title$,(x1%,y1%)-(x2%,y2%),type%
  1573.   COLOR 1,2:CLS:LOCATE 1,3:COLOR 2,3:PRINT  " DOUGIE BASE - ";n$;:COLOR 1,2:PRINT " "
  1574. END SUB
  1575.  
  1576. figures:
  1577.   CALL banner (2," CHOOSE NUMBER OF FIGURES PER COLUMN : ",0,0,631,52,18)
  1578.  choosefigure:
  1579.   LOCATE 3,1:INPUT "  ENTER 5 OR 6 FOR # OF FIGURES BEFORE DECIMAL.";figures
  1580.   IF figures < 5 OR figures > 6 THEN GOTO choosefigure
  1581.   WINDOW CLOSE 2:RETURN
  1582.   
  1583. globalscreen:
  1584.  printer = 0
  1585.  WINDOW 2," DOUGIE BASE     GLOBAL SEARCH  ",(0,0)-(631,52),18
  1586.  globalscreen = 1:COLOR 1,2:GOSUB 8150 
  1587.  FOR i = 1 TO g-1 'subtract because g incremented in search on screen
  1588.  FOR y = 1 TO f
  1589.  PRINT  search$(i,y);
  1590.  IF printer = 1 THEN PRINT# 4,search$(i,y);
  1591.  NEXT y
  1592.  IF printer = 1 THEN PRINT# 4,""
  1593.  x$ = INKEY$:IF x$ = CHR$(32) THEN GOSUB waitforspace
  1594.  IF x$ <> "" THEN i = g
  1595.  NEXT i
  1596.   PRINT:PRINT:PRINT  "   Press <";:COLOR 2,3:PRINT  " SPACE BAR ";:COLOR 1,2:PRINT  "> to continue !"
  1597.   GOSUB waitforspace
  1598.   WINDOW CLOSE 2:RETURN
  1599.  
  1600. globaldisk:
  1601.  globaldisk = 1
  1602.  INPUT "  ENTER NAME FOR GLOBAL SEARCH FILE :",globalname$
  1603.  GOSUB 15200
  1604.  transfern = n:transfern$ = n$:transferdb$ = db$:db$ = globalname$:n = g - 1 ' compensate for last g+1 so extra blank record isn't saved.
  1605.  fileno$ = STR$(globfilno):globfilno$ = MID$(fileno$,2)
  1606.  n$ =globfilno$ + globalname$:GOSUB globhdr:GOSUB saveroutine
  1607.  n = transfern:n$ = transfern$:db$ = transferdb$
  1608.  globaldisk = 0:RETURN
  1609.  
  1610. whichfield:
  1611.  PRINT :PRINT "  CHANGE WHICH FIELD  -  ENTER 1 TO ";f;" ENTER '0' FOR REDO FROM START !"
  1612.  GOSUB getkee:IF VAL(x$) <0 OR VAL(x$) > f THEN PRINT "  THERE ARE ONLY ";f;"FIELDS !":GOSUB getkee
  1613.  IF x$ = "0" THEN CLEAR:DEFINT a -z :cl = 1:GOTO 15
  1614.  i = VAL(x$)
  1615.  PRINT :INPUT "  ENTER NEW HEADING. ",head$
  1616.  IF uniform = 1 THEN
  1617.   IF LEN(hd$(i)) > l THEN PRINT "  TOO MANY CHARACTERS > ";l:INPUT "  ENTER NEW HEADING .",head$
  1618.   hd$(i) = head$ + LEFT$(bl$,h - LEN(head$))
  1619.  END IF
  1620.  IF uniform = 2 THEN
  1621.   IF LEN(head$) > l THEN PRINT "  TOO MANY CHARACTERS > ";l:INPUT "  ENTER NEW HEADING .",head$
  1622.   hd$(i) = head$ + LEFT$(bl$,l - LEN(head$))
  1623.  END IF
  1624.  IF v = 1 THEN
  1625.   IF LEN(head$) > LEN(hd$(i)) THEN PRINT "  TOO MANY CHARACTERS > ";PRINT LEN(hd$(i)):INPUT "  ENTER NEW HEADING .",head$
  1626.   hd$(i) = head$ + LEFT$(bl$,lf(i) - LEN(head$))
  1627.  END IF 
  1628.  GOTO final
  1629.    
  1630. writeformatfile:
  1631.   ON ERROR GOTO errortrap
  1632.   preformat = 0
  1633.   OPEN "O" ,#2, "pfmnote" + n$ 'preformat flag saved
  1634.   WRITE #2 ,preformat
  1635.   CLOSE #2
  1636.   ON ERROR GOTO 0
  1637.   RETURN                                       
  1638.    
  1639.